Can you write a VBA program in the "Import Data" button to import the data in the yellow marked cells of the queues in the folder into the cells marked by the color of the corresponding team in the summary table? Thank you! See the attachment. |
Attachment:
You need to log on to download or view the attachment. No account? Register
Sub YY ()
Dim s as worksheet, p $, F $,
Set S = activesheet
P = thisworkbook. Path &"/"
F = Dir (P & "*. xls ")
On Error resume next
Application. screenupdating = false
Do while F <> ""
If F <> thisworkbook. name then
Workbooks. Open P & F
A = activesheet. [i7: i36]. Value
S. cells (7, Val (f) * 14 + 9). Resize (30, 1) =
End if
Workbooks (f). Close true
F = dir
Loop
Application. screenupdating = true
End sub ----------------------------------------------
Before solving your problem, you should first learn the Dir function, which can be used to return all files in a folder Sub thisfilderallfile () 'Multiple Excel files in the same folder as the current workbook are returned. Dim Arr () 'Dir [(pathname [, attributes])] The 'dir function can return all files in a folder (excluding subfolders). If no files exist in a folder, a null value is returned. Worksheets. Add Myfile = Dir (thisworkbook. Path & "/*. xls", vbnormal) 'assigns the first Excel file in the folder where the workbook is located to myfile Redim Arr (1 to 1) 'defines a one-dimensional array, which contains an element Arr (1) = myfile T = 1 Do While myfile <> "" 'Dir will return the first file name that matches pathname. If you want to get another file name that matches the pathname, call dir again and do not use the parameter. If no matching file exists, Dir returns a zero-length string (""). Once the return value is a zero-length string and you want to call dir again, you must specify the pathname. Otherwise, an error occurs. Myfile = dir T = t + 1 Redim preserve Arr (1 to T) 'Here the preserve keyword is mainly used to reserve the previous values of the array. Arr (t) = myfile Loop Range ("A1: A" & T) = application. worksheetfunction. transpose (ARR) 'because the array is a one-dimensional horizontal (column) array, it needs to be transposed to the cell area, which is a way to quickly pass values to the cell area of the array. End sub Sub Summary () 'Multiple Excel files in the same folder as the current workbook are returned. Dim Arr () Dim mystring as string Application. screenupdating = false Mystring = activeworkbook. Name P = thisworkbook. Path Myfile = Dir (thisworkbook. Path & "/*. xls", vbnormal) T = 1 Do While myfile <> "" If myfile = "" Then exit do 'When dir returns a null value, it indicates that all Excel files in the folder have been cyclically completed and the loop should be exited; otherwise, an error will occur when opening If myfile <> mystring then M = m + 1 Workbooks. Open filename: = P & "/" & myfile' open the workbook one by one A = activesheet. [i7: i36]. Value Sheet1.cells (7, 23 + 14 * (m-1). Resize (30, 1) = A' observe the relationship among columns such as 1, 2, and 3. Activeworkbook. Close savechanges: = false End if Myfile = dir Loop Application. screenupdating = true End sub |
----------------------------------------------
In the summary table, I set the = sum (W9: W10) formula for the W8 cell, and the = sum (W14: w16) formula for the W13 cell, in cells W22, The = sum (W23: w25) formula is set. For other ak8/ak13/ak22/ay8/ay13/ay22 cells, the formula is the same, if you run the moderator program, the formula of these cells will be overwritten. |