جمع کردن یک سلول از تمام فایل های داخل یک فولدر

Collapse
X
 
  • زمان
  • نمایش
حذف همه
new posts
  • princenothing

    • 2015/12/27
    • 23
    • 49.00

    جمع کردن یک سلول از تمام فایل های داخل یک فولدر

    با سلام خدمت دوستان
    من تعداد زیادی فایل دارم که هر روز هم به تعدادشون اضافه میشه.
    می خوام برای گزارش ماهیانه همه رو توی یک فولدر قرار بدم و اگر امکانش باشه راهی رو بهم معرفی کنید که بتونم تمام سلول های یکسانی رو در تمام فایل ها با هم جمع کنه. (مثلا سلول a1 همه فایل ها با هم جمع بشن)
    اگر امکانش هست منو راهنمایی کنید.
    ممنونم
  • rahi_feri

    • 2014/08/08
    • 524
    • 94.67

    #2
    سلام
    فقط جمع کنید مثه حالت عادیش با ایت تفاوت که نام کاربرگ هم آورده میشه!
    اگر منظورتون خوندن نام ورک بوک ها هست اون فرق میکنه!
    [B][SIZE=1]بخش امضاء :
    [/SIZE][/B][LEFT]
    [CODE]
    Sub Macro()
    ActiveCell = "IY" & Right(Application.Name, 5)
    With ActiveCell.Characters(Start:=2, Length:=1).Font
    .Name = "Webdings"
    .Color = 255
    End With
    End Sub
    [/CODE]
    [/LEFT]

    کامنت

    • princenothing

      • 2015/12/27
      • 23
      • 49.00

      #3
      می خوام یه حالتی باشه که هر فایلی که در فولدر اضافه شد به صورت اتوماتیک این کار رو روش انجام بده. حتما لازم نباشه که من آدرس اون فایل رو هم بدم.
      اگر تعداد کمی بود راحت میشد. ولی در هر روز تقریبا 20-30 گزارش هست و از یه جایی به بعد اکسل کند میشه و نمیشه توی فرمول به راحتی تغییرات داد

      کامنت

      • iranweld

        • 2015/03/29
        • 3341

        #4
        با سلام

        فایل و پوشه پیوست را در درایو D کپی کنید و سپس فایل jame file A1 را اجرا کنید

        سلول A1 فایلهای موجود در پوشه TEST با هم جمع شده و در فایل jame file A1 در سلول A1 نمایش داده میشود

        کد PHP:
        Private Sub CommandButton1_Click()

        Dim directory As StringfileName As Stringcc As Stringsheet As WorksheetAs IntegerAs Integerxx As Longyy As Long


        Application
        .ScreenUpdating False

        cc 
        ActiveWorkbook.Name

        Workbooks
        (cc).Worksheets(1).Cells(11).Value ""

        'directory = "d:\test\"'

        fileName Dir(directory "*.xl??")

        Do While 
        fileName <> ""
               
           
        xx Workbooks(cc).Worksheets(1).Cells(11).Value
                
            Workbooks
        .Open (directory fileName)
            
            
        Worksheets(1).Select
              
            Workbooks
        (cc).Worksheets(1).Cells(11).Value xx ActiveSheet.Cells(11).Value
                
                
            Workbooks
        (fileName).Close
            
            fileName 
        Dir()
            
        Loop

        Application
        .ScreenUpdating True

        End Sub 
        فایل های پیوست شده

        کامنت

        چند لحظه..