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

[princenothing]

با سلام

من تعداد خیلی زیادی فایل اکسل گزارش روزانه دارم(8 کارگاه و هر کارگاه یک گزارش در روز)
تعدادی سلول ثابت وجود داره که باید در آخر هر ماه (مثل 50 سلول ثابت) با هم جمع بشه و در یک فایل اکسل مجزا جمع آوری بشه.
راهی وجود داره که بتونم بگم به طور مثال تمام سلول های a1 در تمام فایل ها با هم جمع بشن و مقدار در شیت جدید نمایش داده بشه؟

[iranweld]

با سلام

چنانچه ترتیب نامگذاری فایلهای شما از فرمت خاص و یکجور پیروی مینماید مثلا BOOK1 و BOOK2 و ........
پوشه پیوست را در درایو E کپی نموده و فایل SUM را باز نموده و ماکرو آنرا اجرا کنید.
در این ماکرو کلیه سلولهای A1 فایلهای موجود بجز SUM با هم جمع میگردد

Public i As Integer

Sub Macro2()

XX = 0

Columns("A:A").ClearContents

 FileList

For K = 1 To i - 2

XX = Range("B2")

    Range("A" & K).Consolidate Sources:=Array("'E:\test\[Book" & K & ".xlsx]Sheet1'!R1C1"), Function:= _
        xlsum, TopRow:=False, LeftColumn:=False, CreateLinks:=False
        
        Range("B2") = XX + Range("A" & K)
        
        Next
End Sub


Sub FileList()

'========== بدست آوردن تعداد فايل در پوشه جاري'
         Dim objFSO As Object
         Dim objFolder As Object
         Dim objFile As Object
         i = 1
         Set objFSO = CreateObject("Scripting.FileSystemObject")
         Set objFolder = objFSO.GetFolder("e:\test\" & "")
         For Each objFile In objFolder.Files
          ' MsgBox objFile.Name
          i = i + 1
         Next objFile
       '  MsgBox XX
     End Sub 

[Amir Ghasemiyan]

با سلام

من تعداد خیلی زیادی فایل اکسل گزارش روزانه دارم(8 کارگاه و هر کارگاه یک گزارش در روز)
تعدادی سلول ثابت وجود داره که باید در آخر هر ماه (مثل 50 سلول ثابت) با هم جمع بشه و در یک فایل اکسل مجزا جمع آوری بشه.
راهی وجود داره که بتونم بگم به طور مثال تمام سلول های a1 در تمام فایل ها با هم جمع بشن و مقدار در شیت جدید نمایش داده بشه؟

سلام دوست عزیز
روش حل رو که دوستمون فرمودن اما چرا انقدر فایل؟
نمیشه برای هر کارگاه یک فایل باشه و هر روز تو یک شیت بریزن اطلاعات رو؟ اینطوری هم جمع و جور تره هم راحت تر میشه محاسبات انجام داد
حتی اگه بتونین یک فرم طراحی کنین که اطلاعات رو داخل یک جدولی بریزه میتونین با یک شیت هم کارتون رو راه بندازین. اینطوری علاوه بر محاسباتی که میخواین میتونین تجزیه و تحلیل هایی هم رو کار داشته باشید

[امين اسماعيلي]

ba drod code zir kare shomaro rah mindaze, farz konin shoma ye folderi dari ke hameye on file haye excelet onjast, chand tasho mohem nist. ye file asli ham dari ke mikhi masalan tamame selhaye a1 file haye mazkor ro biari to in file asli zire ham bezarishon to setone A.
khob code zir mitone komaketon kone bakhshhai ro ke man baraton ghermez mikonamo bayad taghir bedi chon address folderi ke on n ta file onjast ba man fargh dare

Sub MergeSelectedWorkbooks()
Application.ScreenUpdating = False
Application.EnableEvents = False
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim SelectedFiles() As Variant
    Dim NRow As Long
    Dim FileName As String
    Dim NFile As Long
    Dim WorkBk As Workbook
    Dim SourceRange As Range
    Dim DestRange As Range
    
    ' Create a new workbook and set a variable to the first sheet.
    Set SummarySheet = Sheet1
    
    ' Modify this folder path to point to the files you want to use.
[COLOR=#ff0000]    FolderPath = "Z:\k3931\Desktop\New folder\New folder"[/COLOR]
    
    ' Set the current directory to the the folder path.
    ChDrive FolderPath
    ChDir FolderPath
    
    ' Open the file dialog box and filter on Excel files, allowing multiple files
    ' to be selected.
    SelectedFiles = Application.GetOpenFilename( _
        filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)
    
    ' NRow keeps track of where to insert new rows in the destination workbook.
[COLOR=#00ff00]    NRow = 2[/COLOR]
    
    ' Loop through the list of returned file names
    For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
        ' Set FileName to be the current workbook file name to open.
        FileName = SelectedFiles(NFile)
        
        ' Open the current workbook.
        Set WorkBk = Workbooks.Open(FileName)
     
        ' Set the source range to be A1 , you can change this to any range that you want
        ' Modify this range for your workbooks. It can span multiple rows.
     [COLOR=#00ff00]   Set SourceRange = WorkBk.Worksheets(1).Range("A1")
[/COLOR]        
        ' Set the destination range to start at column B and be the same size as the source range.
  [COLOR=#00ff00]      Set DestRange = SummarySheet.Range("A" & NRow)[/COLOR]
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
           SourceRange.Columns.Count)
           
        ' Copy over the values from the source to the destination.
        DestRange.Value = SourceRange.Value
        
        ' Increase NRow so that we know where to copy data next.
        NRow = NRow + DestRange.Rows.Count
        
        ' Close the source workbook without saving changes.
        WorkBk.Close savechanges:=False
    Next NFile
    
    ' Call AutoFit on the destination sheet so that all data is readable.
    SummarySheet.Columns.AutoFit
    Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

khob berim sare tozihat

khate ghermez ke hatman bayad taghir kone.bad az run shodan mostaghiman be addrese morede nazar mirin, harchandta az on filaro khastin mitonin entekhab konin
khate ghermez mishe address on foldere ke filat onjast. dar zemn alamataye "" ke hast pak nashe beinesh copy mikoni
ama khotote sabz basete be nazare shomas
masalan

Set SourceRange = WorkBk.Worksheets(1).Range("A1")

to inja ma dariom migim ke on filaye ke mikhaim copy shon konim to in file aslimon. sheet1 eshon range A1 eshon ro mikhaim copy barash sorat begire tavajoh kon ke ma do ta name to code nevisi darim yeki name hast ke shoma be rahati vase sheet haton taghir midi va ye nameke code nevisi hastesh va mamolan ma az in name vase barname nevisi estefade mikonim ke agar karbar esme sheet ro taghir dad code hamon ba moshkel movajeh nashan. vaghti ye sheeti ro entekhab koni va ro tabesh rast click koni view code ro bezani ye panjare baz mishe ke samte chap mitoni befahmi esme codi on sheet chie
shoma agar khasti mitoni in 1 ro bokoni 2 ya 3 ya .. va range ro ham bezari harchi masalan C2 ya hata range mesle A2:A10
badesh mimone inke koja cop beshan to file aslimon

  NRow = 2

khate bala dare mige dadeham az radife 2 o file asli shoro be copy shodan bokonan va ama daghighan koja

et DestRange = SummarySheet.Range("A" & NRow)

to setone A
hala in seton mitone taghir kone. ya hata radifi ke arz shod khedmateton. dar nahayat shoma hame etelato dari bad har balai khasi sareshon dar biar . sum begir ya har chi made nazarete



dige az in vazeh tar nemitonesam tozih bedam. inam ye hadie az taafe site bod azizam.movafagh bashi

nemone file ham mizaram ke betoni ide begiri

[princenothing]

سلام دوست عزیز
روش حل رو که دوستمون فرمودن اما چرا انقدر فایل؟
نمیشه برای هر کارگاه یک فایل باشه و هر روز تو یک شیت بریزن اطلاعات رو؟ اینطوری هم جمع و جور تره هم راحت تر میشه محاسبات انجام داد
حتی اگه بتونین یک فرم طراحی کنین که اطلاعات رو داخل یک جدولی بریزه میتونین با یک شیت هم کارتون رو راه بندازین. اینطوری علاوه بر محاسباتی که میخواین میتونین تجزیه و تحلیل هایی هم رو کار داشته باشید

حتما محدودیت هایی وجود داره، ممنون از راهنماییتون

[princenothing]

با سلام

چنانچه ترتیب نامگذاری فایلهای شما از فرمت خاص و یکجور پیروی مینماید مثلا BOOK1 و BOOK2 و ........
پوشه پیوست را در درایو E کپی نموده و فایل SUM را باز نموده و ماکرو آنرا اجرا کنید.
در این ماکرو کلیه سلولهای A1 فایلهای موجود بجز SUM با هم جمع میگردد

Public i As Integer

Sub Macro2()

XX = 0

Columns("A:A").ClearContents

 FileList

For K = 1 To i - 2

XX = Range("B2")

    Range("A" & K).Consolidate Sources:=Array("'E:\test\[Book" & K & ".xlsx]Sheet1'!R1C1"), Function:= _
        xlsum, TopRow:=False, LeftColumn:=False, CreateLinks:=False
        
        Range("B2") = XX + Range("A" & K)
        
        Next
End Sub


Sub FileList()

'========== بدست آوردن تعداد فايل در پوشه جاري'
         Dim objFSO As Object
         Dim objFolder As Object
         Dim objFile As Object
         i = 1
         Set objFSO = CreateObject("Scripting.FileSystemObject")
         Set objFolder = objFSO.GetFolder("e:\test\" & "")
         For Each objFile In objFolder.Files
          ' MsgBox objFile.Name
          i = i + 1
         Next objFile
       '  MsgBox XX
     End Sub 

فایل های موجود به غیر از SUM با هم جمع میشن ، منظور از SUM چیه؟!
rang ("b2" این مربوط به چی میشه؟ (برای اطلاع خودم می خوام)

ممنون از کمکتون

[iranweld]

منظور کلیه فایلها موجود در پوشه Testدر جمع وارد میشوند بجز فایل SUM

[iranweld]

این هم یک نمونه فایل دیگر که نیازی به مشابه بودن فرمت نامگذاری فایلهای داخل پوشه test در درایو E نمیباشد

فقط این فایل را خارج از پوشه E:\TEST کپیکنید.

Private Sub CommandButton1_Click()

Static total As Integer

Dim directory As String, fileName As String, sheet As Worksheet


total = 0

Application.ScreenUpdating = False

directory = "E:\test\"

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

Do While fileName <> ""

        
    Workbooks.Open (directory & fileName)
    
          
   total = total + Sheets("Sheet1").Range("A1")
   
       
    Workbooks(fileName).Close
    
    fileName = Dir()
    
        
Loop

Application.ScreenUpdating = True

Range("A1") = total

End Sub 

[saeid_f]

با سلام

چنانچه ترتیب نامگذاری فایلهای شما از فرمت خاص و یکجور پیروی مینماید مثلا book1 و book2 و ........
پوشه پیوست را در درایو e کپی نموده و فایل sum را باز نموده و ماکرو آنرا اجرا کنید.
در این ماکرو کلیه سلولهای a1 فایلهای موجود بجز sum با هم جمع میگردد

public i as integer

sub macro2()

xx = 0

columns("a:a").clearcontents

 filelist

for k = 1 to i - 2

xx = range("b2")

    range("a" & k).consolidate sources:=array("'e:\test\[book" & k & ".xlsx]sheet1'!r1c1"), function:= _
        xlsum, toprow:=false, leftcolumn:=false, createlinks:=false
        
        range("b2") = xx + range("a" & k)
        
        next
end sub


sub filelist()

'========== بدست آوردن تعداد فايل در پوشه جاري'
         dim objfso as object
         dim objfolder as object
         dim objfile as object
         i = 1
         set objfso = createobject("scripting.filesystemobject")
         set objfolder = objfso.getfolder("e:\test\" & "")
         for each objfile in objfolder.files
          ' msgbox objfile.name
          i = i + 1
         next objfile
       '  msgbox xx
     end sub 

با سلام و وقت بخیر
من خیلی به این ماکرو نیاز دارم برای جمع بندی نظرات کاربران شرکت کننده در یک کارگاه آموزشی
فقط بی زحمت بفرمایید که چطور میتونیم این ماکرو رو برای جمع چندین سلول متفاوت دیگر استفاده کنیم.
این ماکرو میتونه همه سلول های a1 موجود در تمامی فایل ها رو جمع کنه و در سلول b2 فایل sum جمع کنه
من میخوام :
الف -تمامی سلول های a1 رو در b2
ب- تمامی سلول های a2 رو در b3
ج - تمامی سلول های a3 رو در b4
و هر چند سلول رو که خواستم جمع کنه
ممنون

[iranweld]

با سلام

فایل پیوست را بررسی کنید

مسیر فایلهایی که باید بررسی شود در فولدر

directory = "E:\test\" 

که میتوانید به فولدر و درایو مورد نظر خود تغییر دهید

نام شیت های مقصدی که بررسی میشود

Sheets("Sheet1").Range("A1") 

Private Sub CommandButton1_Click()

Static total1, total2, total3 As Integer

Dim directory As String, fileName As String, sheet As Worksheet


total1 = 0
total2 = 0
total3 = 0

Application.ScreenUpdating = False

directory = "E:\test\"

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

Do While fileName <> ""

        
    Workbooks.Open (directory & fileName)
    
          
   total1 = total1 + Sheets("Sheet1").Range("A1")
   total2 = total2 + Sheets("Sheet1").Range("A2")
   total3 = total3 + Sheets("Sheet1").Range("A3")
   
       
    Workbooks(fileName).Close
    
    fileName = Dir()
    
        
Loop

Application.ScreenUpdating = True

Range("B2") = total1
Range("B3") = total2
Range("B4") = total3

End Sub 

[iranweld]

با سلام و وقت بخیر
من خیلی به این ماکرو نیاز دارم برای جمع بندی نظرات کاربران شرکت کننده در یک کارگاه آموزشی
فقط بی زحمت بفرمایید که چطور میتونیم این ماکرو رو برای جمع چندین سلول متفاوت دیگر استفاده کنیم.
این ماکرو میتونه همه سلول های a1 موجود در تمامی فایل ها رو جمع کنه و در سلول b2 فایل sum جمع کنه
من میخوام :
الف -تمامی سلول های a1 رو در b2
ب- تمامی سلول های a2 رو در b3
ج - تمامی سلول های a3 رو در b4
و هر چند سلول رو که خواستم جمع کنه
ممنون

با این کد کلیه شیت های فایلهای مقصد مورد برسی قرار گرفته و سلولهای A1,A2,A3هر شیت در جمع لحاظ میگردد

Private Sub CommandButton1_Click()

Static total1, total2, total3 As Integer

Dim directory As String, fileName As String, sheet As Worksheet, I As Integer


total1 = 0
total2 = 0
total3 = 0

Application.ScreenUpdating = False

directory = "E:\test\"

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

Do While fileName <> ""

        
    Workbooks.Open (directory & fileName)
    
    For I = 1 To Sheets.Count
    
   total1 = total1 + Sheets(I).Range("A1")
   total2 = total2 + Sheets(I).Range("A2")
   total3 = total3 + Sheets(I).Range("A3")
   
   Next
   
       
    Workbooks(fileName).Close
    
    fileName = Dir()
    
        
Loop

Application.ScreenUpdating = True

Range("B2") = total1
Range("B3") = total2
Range("B4") = total3

End Sub 

[saeid_f]

با سلام

فایل پیوست را بررسی کنید

مسیر فایلهایی که باید بررسی شود در فولدر

directory = "E:\test\" 

که میتوانید به فولدر و درایو مورد نظر خود تغییر دهید

نام شیت های مقصدی که بررسی میشود

Sheets("Sheet1").Range("A1") 

Private Sub CommandButton1_Click()

Static total1, total2, total3 As Integer

Dim directory As String, fileName As String, sheet As Worksheet


total1 = 0
total2 = 0
total3 = 0

Application.ScreenUpdating = False

directory = "E:\test\"

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

Do While fileName <> ""

        
    Workbooks.Open (directory & fileName)
    
          
   total1 = total1 + Sheets("Sheet1").Range("A1")
   total2 = total2 + Sheets("Sheet1").Range("A2")
   total3 = total3 + Sheets("Sheet1").Range("A3")
   
       
    Workbooks(fileName).Close
    
    fileName = Dir()
    
        
Loop

Application.ScreenUpdating = True

Range("B2") = total1
Range("B3") = total2
Range("B4") = total3

End Sub 

خیلی ممنون و سپاسگزارم
با این کدها کار من راه می افته و خیلی در وقت من صرفه جویی میشه
فقط یک نکته:
از سلول D7 تا H21حدود ۷۵ تا سلول هست.
اگه بخوام اعدادی که در این ۷۵ سلول در همه فایل ها هست رو جمع بزنه و در فایل دیگری در ۷۵ سلول بنویسه لزوما باید ۷۵ تا total تعریف کنم