Cần sự giúp đỡ tạo Sheet tổng hợp

Chia sẻ bởi:hands
★★★★★
‹ Lỗi không copy được dữ liệu từ... Dùng SQL trên Excel ›
Quảng cáo

Tình hình là e cần tổng hợp nhiều file dữ liệu khách hàng thành 1. Ae giúp cái code để có được sheet tổng hợp giống mẫu mẫu

Bạn xem code nhé.

Sub tonghop()
Dim arr, arr1, sh As Object, lr As Long, a As Long, j As Integer, i As Long
    ReDim arr1(1 To 10000, 1 To 11)
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> "TONGHOP" And sh.Visible = True Then
           lr = sh.Range("C" & Rows.Count).End(xlUp).Row
           If lr > 3 Then
              arr = sh.Range("A4:K" & lr).Value
              For i = 1 To UBound(arr, 1)
                  a = a + 1
                  arr1(a, 1) = a
                  For j = 2 To UBound(arr, 2)
                      arr1(a, j) = arr(i, j)
                  Next j
             Next i
         End If
      End If
   Next
   With Sheets("TONGHOP")
       lr = .Range("C" & Rows.Count).End(xlUp).Row
       If lr > 3 Then .Range("A4:K" & lr).ClearContents
       If a Then .Range("A4").Resize(a, 11).Value = arr1
   End With
End Sub

www.giaiphapexcel.com/diendan/threads/c%E1%BA%A7n-s%E1%BB%B1-gi%C3%BAp-%C4%91%E1%BB%A1-t%E1%BA%A1o-sheet-t%E1%BB%95ng-h%E1%BB%A3p.140742/

Kỹ năng giải quyết vấn đề hiệu quả
Khóa học SprinGO phù hợp

Kỹ năng giải quyết vấn đề hiệu quả

Mô tả Nội dung Đánh giá Tài nguyên KỸ NĂNG GIẢI QUYẾT VẤN ĐỀ HIỆU QUẢHiểu đúng vấn đề là một nửa của giải...

Xem khóa học
★★★★★ 5 ★ 1 👤 1 ▥ 0
‹ Lỗi không copy được dữ liệu từ file... Dùng SQL trên Excel ›
Quảng cáo

Bạn nên đọc

One Response

  1. hands says:
    27/01/2023 at 3:10 pm

    Gửi bạn tham khảo:

    Sub Tonghop()
    Dim Cn As Object, Rst As Object, Ws As Worksheet
    Dim lR As Long, lR1 As Long, sql As String

Set Cn = CreateObject("ADODB.Connection")
    Set Rst = CreateObject("ADODB.Recordset")

With Cn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & _
                      ";Extended Properties=""Excel 12.0 Xml;HDR=NO;"""
        .Open
    End With

For Each Ws In ThisWorkbook.Sheets
        If Ws.Name <> "TONGHOP" And Ws.Name <> "H.DAN" Then
            'Tim dong trong dau tien tai Sheet("TONGHOP") de paste du lieu
            lR = Sheet2.Range("C" & Rows.Count).End(xlUp).Row + 1
            If lR < 4 Then lR = 4

'Tim dong cuoi cung co du lieu
            lR1 = Ws.Range("C" & Rows.Count).End(xlUp).Row
            If lR1 >= 4 Then
                sql = "SELECT * FROM [" & Ws.Name & "$B4:K" & lR & "]"
                Set Rst = Cn.Execute(sql)
                Sheet2.Range("B" & lR).CopyFromRecordset Rst
            End If
        End If
    Next Ws

Set Cn = Nothing: Set Rst = Nothing
    MsgBox "Done", vbInformation, "GPE"
End Sub

    Cảm ơn bạn. nhưng đôi lúc mình có thêm bớt cột nên mình tìm hiểu thêm nhiều code khác

    Tôi bị nhầm 1 dòng, bạn sửa lại như sau:
    Từ:

    sql = "SELECT * FROM [" & Ws.Name & "$B4:K" & lR & "]"

    Thành:

    sql = "SELECT * FROM [" & Ws.Name & "$B4:K" & lR1 & "]"

    Trường hợp bạn muốn sắp xếp theo thứ tụ tăng dần, tôi chưa nghĩ ra cách làm toàn bộ, mới nghĩ ra cách làm cho từng sheet thành phần khi tổng hợp vào thôi. Bạn sửa dòng lệnh sql thành:

    sql = "SELECT * FROM [" & Ws.Name & "$B4:K" & lR1 & "] ORDER BY F2 ASC"

    @Hai Lúa Miền Tây: xin nhờ anh xem giúp cho trường hợp sắp xếp theo yêu cầu của chủ thớt khi dùng SQL.

    Reply

Leave a Reply

Your email address will not be published. Required fields are marked *

Quảng cáo
▣ Excel Ứng Dụng

Cũ vẫn chất

Lỗi không copy được dữ liệu từ file text vào excel (sử dụng ADO) Lỗi không copy được dữ liệu từ file text vào excel (sử dụng ADO) Lấy dữ liệu từ file excel khác theo nhiều điều kiện (Dùng VBA) Lấy dữ liệu từ file excel khác theo nhiều điều kiện (Dùng VBA) Giúp đỡ code import file xml vào excel Giúp đỡ code import file xml vào excel Help!! Có cách nào đưa dữ liệu từ nhiều file xml vào trong excel Help!! Có cách nào đưa dữ liệu từ nhiều file xml vào trong excel Tìm phần mềm (Free) chuyển file .xml (của thuế) sang PDF hay Excel Tìm phần mềm (Free) chuyển file .xml (của thuế) sang PDF hay Excel Chuyển đổi từ XML sang Excel Chuyển đổi từ XML sang Excel

Xem thêm