Tổng hợp dữ liệu từ nhiều file khác nhau (1 người xem)

  • Thread starter Thread starter kulyvn
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
K

kulyvn

Thành viên thường trực
Tham gia
3/8/11
Bài viết
283
Được thích
4
Làm sao để tổng hợp danh sách từ 3 file khác nhau vào trong 1 file tổng hợp với điều kiện:
1. Danh sách trong file tổng hợp được tự động đánh số thứ tự
2. Danh sách trong file tổng hợp được sắp xếp theo tháng bắt đầu từ tháng 10 đến tháng cuối cùng là tháng 9 .
Và 1 danh sách tổng hợp tự động sắp xếp theo năm sinh từ nhỏ đến lớn và theo hóa đơn từ số nhỏ đến lớn.
3. Không lấy dữ liệu đối với những hàng trống không có dữ liệu
 

File đính kèm

Lần chỉnh sửa cuối:
kulyvn đã viết:
Làm sao để tổng hợp danh sách từ 3 file khác nhau vào trong 1 file tổng hợp với điều kiện:
1. Danh sách trong file tổng hợp được tự động đánh số thứ tự
2. Danh sách trong file tổng hợp được sắp xếp theo tháng bắt đầu từ tháng 10 đến tháng cuối cùng là tháng 9 .
Và 1 danh sách tổng hợp tự động sắp xếp theo năm sinh từ nhỏ đến lớn và theo hóa đơn từ số nhỏ đến lớn.
3. Không lấy dữ liệu đối với những hàng trống không có dữ liệu
Nhấp chuột vào đây để mở rộng...
- Không đặt tên sheet cần tổng hợp theo điều kiện có dấu tiếng việt
- Thử file này xem có dùng được không?
- Để các file cần tổng hợp trong cùng một "chỗ" để tổng hợp cho tiện
- Chạy code và chọn những file cần tổng hợp
Mã: 
Sub tong_hop_2()
Application.ScreenUpdating = False
On Error GoTo thoat:
Dim data, kq(1 To 65000, 1 To 7), stfile As Variant, I, J, K As Long, st As String, flag As Boolean, WB As Workbook
'--------------------------------------------------------------------------------
 With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = True
    .Show
    For Each stfile In .SelectedItems
        Set WB = Workbooks.Open(stfile)
        With WB.Sheets("Sheet1")
            data = .Range(.[A2], .[A65000].End(xlUp)).Resize(, 7).Value
        End With
        For I = 1 To UBound(data)
            If data(I, 7) <> "" Then
                K = K + 1
                kq(K, 1) = K
                For J = 2 To 7
                    kq(K, J) = data(I, J)
                Next J
            End If
        Next I
        WB.Close False
    Next
End With
'-----------------------------------------------------------------------------------
If K Then
With Sheets("Tong_hop_theo_thang")
    .[A2:G65000].ClearContents
    .[A2].Resize(K, 7) = kq
    .[A2].Resize(K, 7).Borders.LineStyle = xlNone
    .[A2].Resize(K, 7).Borders.LineStyle = xlContinuous
    .[A2].Resize(K, 7).Borders(xlInsideHorizontal).Weight = xlHairline
        .[B2].Resize(K, 6).Select
    ActiveWorkbook.Worksheets("Tong_hop_theo_thang").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tong_hop_theo_thang").Sort.SortFields.Add Key:= _
        Range("F2:F65000"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder _
        := _
        "Tháng 10,Tháng 11,Tháng 12,Tháng 1,Tháng 2,Tháng 3,Tháng 4,Tháng 5,Tháng 6,Tháng 7,Tháng 8,Tháng 9" _
        , DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Tong_hop_theo_thang").Sort
        .SetRange [B2].Resize(K, 6) 'Thay dòng này: .SetRange Range("B2:G19")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    .[A2].Select
End With
End If
'-----------------------------------------------------------------------------------
thoat:
If Err Then MsgBox "co loi xay ra"
Application.ScreenUpdating = True
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Anh sử dụng công cụ gì để tạo ra được như vậy có thể chia sẻ rõ hơn chút được không
 
kulyvn đã viết:
Làm sao để tổng hợp danh sách từ 3 file khác nhau vào trong 1 file tổng hợp với điều kiện:
1. Danh sách trong file tổng hợp được tự động đánh số thứ tự
2. Danh sách trong file tổng hợp được sắp xếp theo tháng bắt đầu từ tháng 10 đến tháng cuối cùng là tháng 9 .
Và 1 danh sách tổng hợp tự động sắp xếp theo năm sinh từ nhỏ đến lớn và theo hóa đơn từ số nhỏ đến lớn.
3. Không lấy dữ liệu đối với những hàng trống không có dữ liệu
Nhấp chuột vào đây để mở rộng...

Xin góp thêm 1 đoạn code sx theo năm sinh và hóa đơn.
Cho tất cả các file vào trong 1 folder, khi chạy chọn folder ko cần chọn các file để gộp. Do sheet Tiếng viêt nên mình đổi tên thành "TH nam sinh hoa don"
Mã: 
Sub GhepFile()
Dim i As Integer, lastrowfile As Integer, lastrowmain As Integer
Dim objExcel As New Excel.Application
Dim objWorkbook, Wbmain As Workbook
Dim FSO As Object
Dim SourceFolder As Object
Dim FileItem As Object
Dim sFolder As String
Application.ScreenUpdating = False
Set Wbmain = ThisWorkbook
lastrowmain = Wbmain.ActiveSheet.Range("B" & Rows.Count).End(3).Row
If lastrowmain > 1 Then Wbmain.ActiveSheet.Range("A2:G" & lastrowmain).ClearContents
Application.FileDialog(msoFileDialogFolderPicker).Show
sFolder = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems.Item(1)
objExcel.Visible = False
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(sFolder)
For Each FileItem In SourceFolder.Files
    If FileItem.Name <> "Danh sach tong hop.xls" And Left(FileItem.Name, 1) <> "~" Then
        Set objWorkbook = objExcel.Workbooks.Open(FileItem.Path)
        lastrowfile = objWorkbook.ActiveSheet.Range("B" & Rows.Count).End(3).Row
        objWorkbook.ActiveSheet.Range("B2:G" & lastrowfile).Copy
        lastrowmain = Wbmain.ActiveSheet.Range("B" & Rows.Count).End(3).Row + 1
        Wbmain.ActiveSheet.Range("B" & lastrowmain).PasteSpecial xlPasteValues
        objWorkbook.Close
    End If
Next FileItem
    Set objExcel = Nothing
    Set objWorkbook = Nothing
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
    
    lastrowmain = Wbmain.ActiveSheet.Range("B" & Rows.Count).End(3).Row
    Wbmain.Worksheets("TH nam sinh hoa don").Sort.SortFields. _
        Clear
    Wbmain.Worksheets("TH nam sinh hoa don").Sort.SortFields. _
    Add Key:=Range("D2:D" & lastrowmain), SortOn:=xlSortOnValues, Order:=xlDescending, _
    DataOption:=xlSortNormal
    Wbmain.Worksheets("TH nam sinh hoa don").Sort.SortFields. _
        Add Key:=Range("G2:G" & lastrowmain), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With Wbmain.Worksheets("TH nam sinh hoa don").Sort
        .SetRange Range("A1:G" & lastrowmain)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    lastrowmain = Wbmain.ActiveSheet.Range("B" & Rows.Count).End(3).Row
    For i = 2 To lastrowmain
        Cells(i, 1) = i - 1
    Next
    Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
kulyvn đã viết:
Anh sử dụng công cụ gì để tạo ra được như vậy có thể chia sẻ rõ hơn chút được không
Nhấp chuột vào đây để mở rộng...
- Sử dụng vba bạn à!.
- Bạn trả lời bài nào thì bấm vào nút trả lời với trích dẫn bạn nhé
Híc híc!. Coi lại mới thấy bài này được đăng ở mục hàm và công thức, vậy mà mình lại đi dùng vba!; Công thức mình không biết đâu!.
 
Lần chỉnh sửa cuối:
Thuyanhanoi đã viết:
- Sử dụng vba bạn à!.
- Bạn trả lời bài nào thì bấm vào nút trả lời với trích dẫn bạn nhé
Nhấp chuột vào đây để mở rộng...
Bạn có thể hướng dẫn mình các bước để tạo được như vậy được không. Mình không nghĩ excel có thể làm được nhiều thứ như thế này. Thật tuyệt vời. Cám ơn bạn nhiều
 
kulyvn đã viết:
Bạn có thể hướng dẫn mình các bước để tạo được như vậy được không. Mình không nghĩ excel có thể làm được nhiều thứ như thế này. Thật tuyệt vời. Cám ơn bạn nhiều
Nhấp chuột vào đây để mở rộng...
- Bạn chịu khó vào GPE mà tìm hiểu, vì mình cũng chẳng biết phải hướng dẫn bạn thế nào nữa; Trên GPE có đủ mọi thứ về excel cho bạn tìm hiểu.
- Đọc các giáo trình về vba tren GPE ất nhiều
- Bạn cần điều gì cho công việc thì trước mắt tìm hiểu cái đó trước, tập viết code, chỗ nào chưa làm được thì hỏi các thành viên trên GPE.
- Mình cũng không biết nhiều đâu; Thấy bài của bạn cũng tượng tự những bài mình dùng trong công việc của mình nên mình viết trả lời thôi.
 
Thuyanhanoi đã viết:
- Bạn chịu khó vào GPE mà tìm hiểu, vì mình cũng chẳng biết phải hướng dẫn bạn thế nào nữa; Trên GPE có đủ mọi thứ về excel cho bạn tìm hiểu.
- Đọc các giáo trình về vba tren GPE ất nhiều
- Bạn cần điều gì cho công việc thì trước mắt tìm hiểu cái đó trước, tập viết code, chỗ nào chưa làm được thì hỏi các thành viên trên GPE.
- Mình cũng không biết nhiều đâu; Thấy bài của bạn cũng tượng tự những bài mình dùng trong công việc của mình nên mình viết trả lời thôi.
Nhấp chuột vào đây để mở rộng...
Cám ơn bạn nhiều nhé
 
quanluu1989 đã viết:
Xin góp thêm 1 đoạn code sx theo năm sinh và hóa đơn.
Cho tất cả các file vào trong 1 folder, khi chạy chọn folder ko cần chọn các file để gộp. Do sheet Tiếng viêt nên mình đổi tên thành "TH nam sinh hoa don"
Mã: 
Sub GhepFile()
Dim i As Integer, lastrowfile As Integer, lastrowmain As Integer
Dim objExcel As New Excel.Application
Dim objWorkbook, Wbmain As Workbook
Dim FSO As Object
Dim SourceFolder As Object
Dim FileItem As Object
Dim sFolder As String
Application.ScreenUpdating = False
Set Wbmain = ThisWorkbook
lastrowmain = Wbmain.ActiveSheet.Range("B" & Rows.Count).End(3).Row
If lastrowmain > 1 Then Wbmain.ActiveSheet.Range("A2:G" & lastrowmain).ClearContents
Application.FileDialog(msoFileDialogFolderPicker).Show
sFolder = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems.Item(1)
objExcel.Visible = False
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(sFolder)
For Each FileItem In SourceFolder.Files
    If FileItem.Name <> "Danh sach tong hop.xls" And Left(FileItem.Name, 1) <> "~" Then
        Set objWorkbook = objExcel.Workbooks.Open(FileItem.Path)
        lastrowfile = objWorkbook.ActiveSheet.Range("B" & Rows.Count).End(3).Row
        objWorkbook.ActiveSheet.Range("B2:G" & lastrowfile).Copy
        lastrowmain = Wbmain.ActiveSheet.Range("B" & Rows.Count).End(3).Row + 1
        Wbmain.ActiveSheet.Range("B" & lastrowmain).PasteSpecial xlPasteValues
        objWorkbook.Close
    End If
Next FileItem
    Set objExcel = Nothing
    Set objWorkbook = Nothing
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
    
    lastrowmain = Wbmain.ActiveSheet.Range("B" & Rows.Count).End(3).Row
    Wbmain.Worksheets("TH nam sinh hoa don").Sort.SortFields. _
        Clear
    Wbmain.Worksheets("TH nam sinh hoa don").Sort.SortFields. _
    Add Key:=Range("D2:D" & lastrowmain), SortOn:=xlSortOnValues, Order:=xlDescending, _
    DataOption:=xlSortNormal
    Wbmain.Worksheets("TH nam sinh hoa don").Sort.SortFields. _
        Add Key:=Range("G2:G" & lastrowmain), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With Wbmain.Worksheets("TH nam sinh hoa don").Sort
        .SetRange Range("A1:G" & lastrowmain)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    lastrowmain = Wbmain.ActiveSheet.Range("B" & Rows.Count).End(3).Row
    For i = 2 To lastrowmain
        Cells(i, 1) = i - 1
    Next
    Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Mình đã tạo được danh sách tự động nhưng không đánh số thứ tự tự động được, giúp mình với
 
kulyvn đã viết:
Ý mình là mình chạy record macro sau đó mình lọc rồi copy qua file mới nhưng số thứ tự thì mình phải gõ vào 1 rồi kéo xuống, còn cách nào khác không?
Nhấp chuột vào đây để mở rộng...

ý của bạn là ko phả vấn đề ở code, mà bạn tự tạo 1 macro cho rieng mình, nhưng ko biết cách tạo số thứ tự tự động?
Nếu lỗi do code mình viết thì bạn chúp ảnh coi.
 
quanluu1989 đã viết:
ý của bạn là ko phả vấn đề ở code, mà bạn tự tạo 1 macro cho rieng mình, nhưng ko biết cách tạo số thứ tự tự động?
Nếu lỗi do code mình viết thì bạn chúp ảnh coi.
Nhấp chuột vào đây để mở rộng...
Mình chạy record macro, sau đó mở file nguồn lên lọc filter, sau đó copy dữ liệu qua file mới, sau đó stop macro. Nhưng khi chạy thì nó báo lỗi auto filter là sao vậy
 
kulyvn đã viết:
Mình chạy record macro, sau đó mở file nguồn lên lọc filter, sau đó copy dữ liệu qua file mới, sau đó stop macro. Nhưng khi chạy thì nó báo lỗi auto filter là sao vậy
Nhấp chuột vào đây để mở rộng...

Nó báo lỗi gì? code macro như thế nảo? bạn phải show thì mng mới biết nó thế nào chư.
 
quanluu1989 đã viết:
Nó báo lỗi gì? code macro như thế nảo? bạn phải show thì mng mới biết nó thế nào chư.
Nhấp chuột vào đây để mở rộng...
Sub xong()
'
' xong Macro
'
' Keyboard Shortcut: Ctrl+Shift+Z
'
Windows("Mau thong ke.xls").Activate
ActiveWindow.SmallScroll Down:=-15
Range("B10:BJ456").Select
Selection.AutoFilter
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 44
ActiveWindow.ScrollColumn = 47
ActiveWindow.ScrollColumn = 50
ActiveWindow.ScrollColumn = 52
ActiveWindow.ScrollColumn = 53
ActiveWindow.ScrollColumn = 54
ActiveWindow.ScrollColumn = 55
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 57
ActiveWindow.ScrollColumn = 58
ActiveWindow.ScrollColumn = 59
ActiveWindow.ScrollColumn = 60
ActiveWindow.ScrollColumn = 59
ActiveWindow.ScrollColumn = 58
ActiveWindow.ScrollColumn = 57
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 55
ActiveWindow.ScrollColumn = 54
ActiveSheet.Range("$B$10:$BJ$456").AutoFilter Field:=59, Criteria1:="="
ActiveSheet.Range("$B$10:$BJ$456").AutoFilter Field:=60, Criteria1:= _
"Tháng 10"
ActiveWindow.ScrollColumn = 52
ActiveWindow.ScrollColumn = 49
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=-12
Range("B10:U91").Select
Selection.Copy
Windows("Danh sach an xong.xls").Activate
Windows("Mau thong ke.xls").Activate
Windows("Danh sach an xong.xls").Activate
ActiveWindow.SmallScroll Down:=-9
Range("B6").Select
ActiveSheet.Paste
Windows("Mau thong ke.xls").Activate
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 33
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 38
ActiveWindow.ScrollColumn = 39
ActiveWindow.ScrollColumn = 40
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 42
ActiveWindow.ScrollColumn = 43
ActiveWindow.ScrollColumn = 44
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 46
ActiveWindow.ScrollColumn = 47
ActiveWindow.ScrollColumn = 48
ActiveWindow.ScrollColumn = 49
ActiveWindow.ScrollColumn = 50
ActiveWindow.ScrollColumn = 51
ActiveWindow.ScrollColumn = 52
ActiveWindow.ScrollColumn = 53
ActiveWindow.ScrollColumn = 54
ActiveWindow.ScrollColumn = 55
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 57
Range("BI10:BI91").Select
Range("BI91").Activate
Application.CutCopyMode = False
Selection.Copy
Windows("Danh sach an xong.xls").Activate
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
Range("V6").Select
ActiveSheet.Paste
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A6").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "1"
Range("A6").Select
Selection.AutoFill Destination:=Range("A6:A13"), Type:=xlFillSeries
Range("A6:A13").Select
End Sub
 
kulyvn đã viết:
Sub xong()
'
' xong Macro
'
' Keyboard Shortcut: Ctrl+Shift+Z
'
Windows("Mau thong ke.xls").Activate
ActiveWindow.SmallScroll Down:=-15
Range("B10:BJ456").Select
Selection.AutoFilter
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 44
ActiveWindow.ScrollColumn = 47
ActiveWindow.ScrollColumn = 50
ActiveWindow.ScrollColumn = 52
ActiveWindow.ScrollColumn = 53
ActiveWindow.ScrollColumn = 54
ActiveWindow.ScrollColumn = 55
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 57
ActiveWindow.ScrollColumn = 58
ActiveWindow.ScrollColumn = 59
ActiveWindow.ScrollColumn = 60
ActiveWindow.ScrollColumn = 59
ActiveWindow.ScrollColumn = 58
ActiveWindow.ScrollColumn = 57
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 55
ActiveWindow.ScrollColumn = 54
ActiveSheet.Range("$B$10:$BJ$456").AutoFilter Field:=59, Criteria1:="="
ActiveSheet.Range("$B$10:$BJ$456").AutoFilter Field:=60, Criteria1:= _
"Tháng 10"
ActiveWindow.ScrollColumn = 52
ActiveWindow.ScrollColumn = 49
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=-12
Range("B10:U91").Select
Selection.Copy
Windows("Danh sach an xong.xls").Activate
Windows("Mau thong ke.xls").Activate
Windows("Danh sach an xong.xls").Activate
ActiveWindow.SmallScroll Down:=-9
Range("B6").Select
ActiveSheet.Paste
Windows("Mau thong ke.xls").Activate
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 33
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 38
ActiveWindow.ScrollColumn = 39
ActiveWindow.ScrollColumn = 40
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 42
ActiveWindow.ScrollColumn = 43
ActiveWindow.ScrollColumn = 44
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 46
ActiveWindow.ScrollColumn = 47
ActiveWindow.ScrollColumn = 48
ActiveWindow.ScrollColumn = 49
ActiveWindow.ScrollColumn = 50
ActiveWindow.ScrollColumn = 51
ActiveWindow.ScrollColumn = 52
ActiveWindow.ScrollColumn = 53
ActiveWindow.ScrollColumn = 54
ActiveWindow.ScrollColumn = 55
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 57
Range("BI10:BI91").Select
Range("BI91").Activate
Application.CutCopyMode = False
Selection.Copy
Windows("Danh sach an xong.xls").Activate
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
Range("V6").Select
ActiveSheet.Paste
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A6").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "1"
Range("A6").Select
Selection.AutoFill Destination:=Range("A6:A13"), Type:=xlFillSeries
Range("A6:A13").Select
End Sub
Nhấp chuột vào đây để mở rộng...

code bạn nên xóa những dòng có chữ "ActiveWindow.ScrollColumn" đi.

Macro ghi lại chính xác những thao tác bạn làm, nên khi bạn thay đổi tên file hay cấu trúc bảng thì nó sẽ báo lỗi hoặc nếu có chạy thì sẽ chạy sai.
 
kulyvn đã viết:
Sub xong()
'
' xong Macro
'
' Keyboard Shortcut: Ctrl+Shift+Z
'
Windows("Mau thong ke.xls").Activate
ActiveWindow.SmallScroll Down:=-15
Range("B10:BJ456").Select
Selection.AutoFilter
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 44
ActiveWindow.ScrollColumn = 47
ActiveWindow.ScrollColumn = 50
ActiveWindow.ScrollColumn = 52
ActiveWindow.ScrollColumn = 53
ActiveWindow.ScrollColumn = 54
ActiveWindow.ScrollColumn = 55
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 57
ActiveWindow.ScrollColumn = 58
ActiveWindow.ScrollColumn = 59
ActiveWindow.ScrollColumn = 60
ActiveWindow.ScrollColumn = 59
ActiveWindow.ScrollColumn = 58
ActiveWindow.ScrollColumn = 57
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 55
ActiveWindow.ScrollColumn = 54
ActiveSheet.Range("$B$10:$BJ$456").AutoFilter Field:=59, Criteria1:="="
ActiveSheet.Range("$B$10:$BJ$456").AutoFilter Field:=60, Criteria1:= _
"Tháng 10"
ActiveWindow.ScrollColumn = 52
ActiveWindow.ScrollColumn = 49
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=-12
Range("B10:U91").Select
Selection.Copy
Windows("Danh sach an xong.xls").Activate
Windows("Mau thong ke.xls").Activate
Windows("Danh sach an xong.xls").Activate
ActiveWindow.SmallScroll Down:=-9
Range("B6").Select
ActiveSheet.Paste
Windows("Mau thong ke.xls").Activate
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 33
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 38
ActiveWindow.ScrollColumn = 39
ActiveWindow.ScrollColumn = 40
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 42
ActiveWindow.ScrollColumn = 43
ActiveWindow.ScrollColumn = 44
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 46
ActiveWindow.ScrollColumn = 47
ActiveWindow.ScrollColumn = 48
ActiveWindow.ScrollColumn = 49
ActiveWindow.ScrollColumn = 50
ActiveWindow.ScrollColumn = 51
ActiveWindow.ScrollColumn = 52
ActiveWindow.ScrollColumn = 53
ActiveWindow.ScrollColumn = 54
ActiveWindow.ScrollColumn = 55
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 57
Range("BI10:BI91").Select
Range("BI91").Activate
Application.CutCopyMode = False
Selection.Copy
Windows("Danh sach an xong.xls").Activate
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
Range("V6").Select
ActiveSheet.Paste
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A6").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "1"
Range("A6").Select
Selection.AutoFill Destination:=Range("A6:A13"), Type:=xlFillSeries
Range("A6:A13").Select
End Sub
Nhấp chuột vào đây để mở rộng...
Mình thấy trong code của bạn chọn rất nhiều file, vì vậy khi chạy code cũng cần có các file đó đang mở. Vã lại để kiểm tra chính xác thì phải có file mới được bạn ơi.
 
quanluu1989 đã viết:
code bạn nên xóa những dòng có chữ "ActiveWindow.ScrollColumn" đi.

Macro ghi lại chính xác những thao tác bạn làm, nên khi bạn thay đổi tên file hay cấu trúc bảng thì nó sẽ báo lỗi hoặc nếu có chạy thì sẽ chạy sai.
Nhấp chuột vào đây để mở rộng...
Làm sao để khi chạy macro thì sẽ hiện thị ra khung để mình có thể chọn file vậy
 
kulyvn đã viết:
Làm sao để khi chạy macro thì sẽ hiện thị ra khung để mình có thể chọn file vậy
Nhấp chuột vào đây để mở rộng...

Bạn nên học thêm VBA, không phải cái gì cũng ghi được bằng macro đâu.
Code hiện khung chọn file:
Application.GetOpenFilename
hoặc
Application.FileDialog(msoFileDialogFilePicker).Show


 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

SA_DQ
[2] Bình luận của Copilot về các ván cờ vua
Trả lời
18
Đọc
466
SA_DQ
SA_DQ
H
Cách tính ngày kết thúc khóa học
Trả lời
2
Đọc
63
Gà Con yêu VBA
Gà Con yêu VBA
E
  • Question Question
Cách nào để sắp xếp lái xe vào list danh sách
Trả lời
3
Đọc
185
Gà Con yêu VBA
Gà Con yêu VBA
havanvinhqh
  • Đã giải quyết
Nâng cấp PM Excel để chạy mượt mà hơn (1 người xem)
    • Ngạc nhiên
    • Cười
Trả lời
5
Đọc
333
Trần Văn Bình
T
L
  • Question Question
Viết code tìm kiếm các file trong Folder
Trả lời
68
Đọc
13K
HeSanbi
HeSanbi
ongke0711
Tạo thông báo nhắc nhở công việc (Excel + PowerShell + Task scheduler)
    • Thích
    • Yêu thích
Trả lời
16
Đọc
485
ongke0711
ongke0711
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
5 6 7
Trả lời
661
Đọc
104K
pycckuu410
pycckuu410
Trungvt3
Get data từ From file excel workbook, load to xong dữ liệu thì Định dạng bị thay đổi so với dữ liệu từ file excel
Trả lời
1
Đọc
87
ptm0412
ptm0412
phuongnam366377
Xây dựng RPC Server cho Excel / Access bằng Delphi – Tận dụng lại DLL và bảo mật mã nguồn
    • Thích
Trả lời
19
Đọc
1K
phuongnam366377
phuongnam366377
Nguyễn Duy Tuân
Hàm BS_TEXT trộn văn bản trong Excel với Add-in A-Tools v10
Trả lời
1
Đọc
503
Nguyễn Duy Tuân
Nguyễn Duy Tuân
G
  • Question Question
Xin hỏi về Lỗi Path Not Found
Trả lời
11
Đọc
238
ongke0711
ongke0711
Maika8008
Liệt kê file trong 1 thư mục của Google Drive
Trả lời
0
Đọc
102
Maika8008
Maika8008
K
Tư vấn dùng máy tính chip AMD hay Intel
Trả lời
6
Đọc
340
vuvo_nhenhang
V
Maika8008
Dùng Apps Script gửi mail hàng loạt từ Google sheets
    • Thích
    • Yêu thích
Trả lời
6
Đọc
311
befaint
befaint
Tiger Nau
In dữ liệu trong word bị lỗi
Trả lời
0
Đọc
74
Tiger Nau
Tiger Nau
J
lỗi không lưu được dữ liệu trong file excel
Trả lời
3
Đọc
133
jenny 129
J
N
  • Question Question
Một lỗi rất khó chịu của VBA khi đọc chuỗi Unicode
    • Thích
Trả lời
3
Đọc
207
ongke0711
ongke0711
nvtnet
  • Question Question
Nhờ các bác giúp đỡ tạo chương trình sao chép dữ liệu vào thư mục con
Trả lời
0
Đọc
101
nvtnet
nvtnet
GPE-Trợ Lý
[ZOOM] POWER QUERY TRAINING (LỚP HỌC POWER QUERY THÁNG 04/2026) (1 người xem)
    • Thích
Trả lời
0
Đọc
5K
GPE-Trợ Lý
GPE-Trợ Lý
minhminh27
File excel thực hiện thao tác lưu trữ (Archive) email của outlook 365
Trả lời
0
Đọc
99
minhminh27
minhminh27
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom