Tính Tổng dữ liệu vào File tổng hợp

[tranaidh]

Tôi muốn tổng hợp dữ liệu từ các files điều tra ý kiến vào một file tổng hợp, mặc dù tôi có thể dùng hàm nhưng rất phức tạp vì có rất nhiều files của nhiều khối lớp ngoai dự kiến. Tôi muốn dùng một đoạn code viết bằng VBA để tính tổng các ý kiến vào một files. vậy ai có thể giúp tôi được không. Tôi xin cảm ơn nhiều.

 

[Quang_Hải]

Tôi muốn tổng hợp dữ liệu từ các files điều tra ý kiến vào một file tổng hợp, mặc dù tôi có thể dùng hàm nhưng rất phức tạp vì có rất nhiều files của nhiều khối lớp ngoai dự kiến. Tôi muốn dùng một đoạn code viết bằng VBA để tính tổng các ý kiến vào một files. vậy ai có thể giúp tôi được không. Tôi xin cảm ơn nhiều.

Bài này không khó nhưng do chưa hiểu rõ ý nên cũng không khoái làm. Tại sao môn toán thì là ABCD, các môn khác thì là số?

 

[tranaidh]

Xin lỗi bác quanghai1969. Vì có chút nhầm lẫn (tôi đã chỉnh sửa file đính kèm). Ý của tôi thế này: tôi muốn tổng hợp số lượng chọn phương án A, B, C, D theo từng môn. VD: Môn Toán lớp 10A có bao nhiêu học sinh chọn đáp án A, B, C, D ...(vì có hơn 1000 file nếu dùng hàm để tính tổng thì quá lâu). Nếu bác biết code VBA nào tổng hợp nhanh xin giúp đỡ.

 

[Quang_Hải]

Xin lỗi bác quanghai1969. Vì có chút nhầm lẫn (tôi đã chỉnh sửa file đính kèm). Ý của tôi thế này: tôi muốn tổng hợp số lượng chọn phương án A, B, C, D theo từng môn. VD: Môn Toán lớp 10A có bao nhiêu học sinh chọn đáp án A, B, C, D ...(vì có hơn 1000 file nếu dùng hàm để tính tổng thì quá lâu). Nếu bác biết code VBA nào tổng hợp nhanh xin giúp đỡ.

Mượn code của anh NDU để giúp cho bạn đây

Function GetListFile(ByVal Folder As String, ByVal Search As String, ByVal InSub As Boolean)
'Code cua anh NDU
  Dim sComm As String, tmpFile
  On Error GoTo ExitSub
  If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
  Folder = """" & Folder & """"
  With CreateObject("Scripting.FileSystemObject")
    tmpFile = .GetTempName
    sComm = "DIR " & Folder & "*" & Search & "* /ON /B /A-D " & IIf(InSub, "/S", " ") & " >" & tmpFile
    CreateObject("Wscript.Shell").Run "cmd /c " & sComm, 0, True
    GetListFile = Split(.OpenTextFile(tmpFile, 1).ReadAll, vbCrLf)
  End With
  Kill tmpFile
ExitSub:
End Function

Sub quanghai()
Application.ScreenUpdating = False
Dim arr As Variant, i As Integer, j As Integer, x As Integer, dl(), KQ(), shName As String, Lop As String
arr = GetListFile(ThisWorkbook.Path, "*.xls?", True)
For i = 1 To UBound(arr)
   If arr(i) <> "" Then
      Workbooks.Open arr(i)
      With ActiveWorkbook
         shName = Left(.Name, 2)
         Lop = Left(.Name, InStrRev(.Name, "-") - 1)
         dl = .ActiveSheet.[A1].End(4).Resize(13, 6).Value
            With Workbooks("Tong Hop.xls").Sheets("Khoi " & shName)
               KQ = .[A:A].Find(Lop).End(4).Resize(13, 6).Value
               For j = 1 To 13
                  For x = 3 To 6
                     KQ(j, x) = KQ(j, x) + Trim(dl(j, x))
                  Next
               Next
               .[A:A].Find(Lop).End(4).Resize(13, 6) = KQ
            End With
         .Close
      End With
   End If
Next
Application.ScreenUpdating = True
End Sub

 

[ndu96081631]

Mượn code của anh NDU để giúp cho bạn đây

Function GetListFile(ByVal Folder As String, ByVal Search As String, ByVal InSub As Boolean)
'Code cua anh NDU
  Dim sComm As String, tmpFile
  On Error GoTo ExitSub
  If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
  Folder = """" & Folder & """"
  With CreateObject("Scripting.FileSystemObject")
    tmpFile = .GetTempName
    sComm = "DIR " & Folder & "*" & Search & "* /ON /B /A-D " & IIf(InSub, "/S", " ") & " >" & tmpFile
    CreateObject("Wscript.Shell").Run "cmd /c " & sComm, 0, True
    GetListFile = Split(.OpenTextFile(tmpFile, 1).ReadAll, vbCrLf)
  End With
  Kill tmpFile
ExitSub:
End Function

Code này đã được cải tiến lại rồi:

Function GetListFile(ByVal Folder As String, ByVal Search As String, ByVal InSub As Boolean)
  Dim sComm As String, tmp As String, tmpFile, Arr, [COLOR=#ff0000]sPath As String[/COLOR]
  On Error Resume Next
  If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
  [COLOR=#ff0000]sPath = """" & Folder & "*" & Search & "*"""[/COLOR]
  With CreateObject("Scripting.FileSystemObject")
    tmpFile = .GetTempName
    sComm = "DIR " [COLOR=#ff0000]& sPath &[/COLOR] " /ON /B /A-D " & IIf(InSub, "/S", " ") & " >" & tmpFile
    CreateObject("Wscript.Shell").Run "cmd [COLOR=#ff0000]/u[/COLOR] /c " & sComm, 0, True
    [COLOR=#ff0000]With .OpenTextFile(tmpFile, 1, , -2)
      tmp = Trim(.ReadAll)
      If Right(tmp, 2) = vbCrLf Then tmp = Left(tmp, Len(tmp) - 2)
      If Len(tmp) Then GetListFile = Split(tmp, vbCrLf)
      .Close
    End With[/COLOR]
  End With
  Kill tmpFile
End Function

Những chổ màu đỏ là chổ thêm và chỉnh sửa lại với mục đích cho code hoạt động chính xác hơn

 

[tranaidh]

Cảm ơn các bác, em làm được rồi...
VBA muôn năm...