Giúp em Công thức Coppy bằng VBA

happyghost2000 · 11/9/19

Nhờ Anh, Chị giúp dùm .
Mình có 2 File Text : Suiko17-1 , Suiko17-5
Mình có file Excel tổng họp : là dữ liệu coppy từ 2 file Text trên .
Mình muốn có đoạn code để nó tự coppy dữ lliệu qua
Yều cầu là các dòng trùng nhau thì cộng lại số lượng ( cột F đến cột U )
Mong Anh, Chị giúp dùm .

Bài đã được tự động gộp: 11/9/19

Mong Anh, Chị giúp dùm em .

kokano90 · 11/9/19

vandia · 11/9/19

kokano90 đã viết:
Lấy dữ liệu file .txt thì bạn thử đọc topic này coi. Còn phần tổng hợp dữ liệu lại thì dùng dictionary coi

Biết thì chỉ dẫn cụ thể, đừng có kiểu hay hớt như vậy

kokano90 · 11/9/19

vandia · 11/9/19

Năng lực em có hạn. Nên em mới nói thế. Chứ gì mà anh gắt thế
Người ta không biết thì mới phải đi hỏi
Bạn đã biết là "năng lực có hạn" thì không nên thách đố nhau bằng kiểu đó.

kokano90 · 11/9/19

vandia đã viết:
Năng lực em có hạn. Nên em mới nói thế. Chứ gì mà anh gắt thế
Người ta không biết thì mới phải đi hỏi
Bạn đã biết là "năng lực có hạn" thì không nên thách đố nhau bằng kiểu đó.

Coi như em sai khi gợi ý như vậy. Cám ơn đã nhắc nhở. Xin phép chủ topic cho mình xóa mấy bài mình vừa đăng

happyghost2000 · 12/9/19

Anh Chị ơi xin giúp em.

happyghost2000 · 12/9/19

@truongvu317 ơi bạn giúp mình với

LamNA · 12/9/19

happyghost2000 đã viết:
Nhờ Anh, Chị giúp dùm .
Mình có 2 File Text : Suiko17-1 , Suiko17-5
Mình có file Excel tổng họp : là dữ liệu coppy từ 2 file Text trên .
Mình muốn có đoạn code để nó tự coppy dữ lliệu qua
Yều cầu là các dòng trùng nhau thì cộng lại số lượng ( cột F đến cột U )
Mong Anh, Chị giúp dùm .

Bài đã được tự động gộp: 11/9/19

Mong Anh, Chị giúp dùm em .

Tôi tiếp bạn nữa chặng đường của bạn phần tổng hợp txt còn việc lọc trùng tính tổng thì đợi anh chị khác đi ngang xem hỗ trợ tiếp bạn không nhé

Mã:

Sub NhapFile_TXT()
Dim Index As Long, n As Long, col As Long, row As Long, Text As String
Dim Rng As Range, FSO As Object, FilesToImport
Dim TextSource As Object, NumOfLines, Cols, Res()
Sheets("ONVSUIK").Range("A2:U65536").ClearContents
Set Rng = Sheets("ONVSUIK").Range("A2")
FilesToImport = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , True)
If IsArray(FilesToImport) Then
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Index = 1 To UBound(FilesToImport)
        n = 0
        Set TextSource = FSO.OpenTextFile(FilesToImport(Index), 1, , -2)
        NumOfLines = Split(TextSource.ReadAll, vbCrLf)
       
        If UBound(NumOfLines) > 0 Then
            ReDim Res(1 To UBound(NumOfLines), 1 To 1)
            For row = 1 To UBound(NumOfLines)
                Text = NumOfLines(row)
                If Text <> "" Then
                    If Text <> String(Len(Text), ",") Then
                        n = n + 1
                        Cols = Split(Text, ",")
                        If UBound(Res, 2) < UBound(Cols) + 1 Then
                            ReDim Preserve Res(1 To UBound(NumOfLines), 1 To UBound(Cols) + 1)
                        End If
                        For col = 1 To UBound(Res, 2)
                            Res(n, col) = Replace(Cols(col - 1), """", "")
                        Next
                    End If
                End If
            Next
        End If
        Rng.Resize(n, UBound(Res, 2)).Value = Res
        Set Rng = Rng.Offset(n)
    Next
End If
End Sub

Hỏi thêm dựa vào cột nào để lọc trùng
cột a,b,c,d hay cả 4 cột trùng mới được tính là trùng với dòng khác

happyghost2000 · 12/9/19

LamNA đã viết:
Hỏi thêm dựa vào cột nào để lọc trùng
cột a,b,c,d hay cả 4 cột trùng mới được tính là trùng với dòng khác

Cả 4 cột trùng nhau thì mới tính là trùng .

Thanks bạn đoạn 1. . Nhiều lắm .

LamNA · 12/9/19

happyghost2000 đã viết:
Cả 4 cột trùng nhau thì mới tính là trùng .

Cảm ơn bạn đoạn 1. . Nhiều lắm .

Tiếp sức tý nữa coi như cũng được 75% giải hết ra vì sức có hạn
Đoạn này coi như đã lấy được dự liệu trong file .txt

Mã:

Sub NhapFile_TXT()
Dim Index As Long, n As Long, col As Long, row As Long, Text As String
Dim Rng As Range, FSO As Object, FilesToImport
Dim TextSource As Object, NumOfLines, Cols, Res()
Sheets("ONVSUIK").Range("A2:U65536").ClearContents
Set Rng = Sheets("ONVSUIK").Range("A2")
FilesToImport = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , True)
If IsArray(FilesToImport) Then
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Index = 1 To UBound(FilesToImport)
        n = 0
        Set TextSource = FSO.OpenTextFile(FilesToImport(Index), 1, , -2)
        NumOfLines = Split(TextSource.ReadAll, vbCrLf)
        
        If UBound(NumOfLines) > 0 Then
            ReDim Res(1 To UBound(NumOfLines), 1 To 1)
            For row = 1 To UBound(NumOfLines)
                Text = NumOfLines(row)
                If Text <> "" Then
                    If Text <> String(Len(Text), ",") Then
                        n = n + 1
                        Cols = Split(Text, ",")
                        If UBound(Res, 2) < UBound(Cols) + 1 Then
                            ReDim Preserve Res(1 To UBound(NumOfLines), 1 To UBound(Cols) + 1)
                        End If
                        For col = 1 To UBound(Res, 2)
                            Res(n, col) = Replace(Cols(col - 1), """", "")
                        Next
                    End If
                End If
            Next
        End If
        Rng.Resize(n, UBound(Res, 2)).Value = Res
        Set Rng = Rng.Offset(n)
    Next
End If
'-----------------------------------------
'goi sub để loc trùng"
Call Loc
'-----------------------------------------
End Sub

Tiếp theo sẽ lọc trùng nhưng code này chỉ lọc trùng 1 cột (a) chưa phải là 3 cột (b,c,d), tạm thời chưa tìm ra giải pháp bạn chờ anh chị khác hỗ trợ thêm cho bạn nhé

Mã:

Sub Loc()
    Dim Dic As Object
    Dim i As Long, j As Long, k As Long
    Dim Tmp As String
    Dim Arr, dArr
    Application.ScreenUpdating = False
    Arr = Range(Sheet1.[A2], Sheet1.[U60000].End(3)).Resize(, 21)
    ReDim dArr(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        For i = 1 To UBound(Arr, 1)
             Tmp = Arr(i, 2)
            If Not .Exists(Tmp) Then
                k = k + 1
                .Add Tmp, k
                For j = 1 To UBound(Arr, 2)
                    dArr(k, j) = Arr(i, j)
                Next j
            Else
                dArr(.Item(Tmp), 6) = dArr(.Item(Tmp), 6) + Arr(i, 6)
                dArr(.Item(Tmp), 7) = dArr(.Item(Tmp), 7) + Arr(i, 7)
                dArr(.Item(Tmp), 8) = dArr(.Item(Tmp), 8) + Arr(i, 8)
                dArr(.Item(Tmp), 9) = dArr(.Item(Tmp), 9) + Arr(i, 9)
                dArr(.Item(Tmp), 10) = dArr(.Item(Tmp), 10) + Arr(i, 10)
                dArr(.Item(Tmp), 11) = dArr(.Item(Tmp), 11) + Arr(i, 11)
                dArr(.Item(Tmp), 12) = dArr(.Item(Tmp), 12) + Arr(i, 12)
                dArr(.Item(Tmp), 13) = dArr(.Item(Tmp), 13) + Arr(i, 13)
                dArr(.Item(Tmp), 14) = dArr(.Item(Tmp), 14) + Arr(i, 14)
                dArr(.Item(Tmp), 15) = dArr(.Item(Tmp), 15) + Arr(i, 15)
                dArr(.Item(Tmp), 16) = dArr(.Item(Tmp), 16) + Arr(i, 16)
                dArr(.Item(Tmp), 17) = dArr(.Item(Tmp), 17) + Arr(i, 17)
                dArr(.Item(Tmp), 18) = dArr(.Item(Tmp), 18) + Arr(i, 18)
                dArr(.Item(Tmp), 19) = dArr(.Item(Tmp), 19) + Arr(i, 19)
                dArr(.Item(Tmp), 20) = dArr(.Item(Tmp), 20) + Arr(i, 20)
                dArr(.Item(Tmp), 21) = dArr(.Item(Tmp), 21) + Arr(i, 21)
            End If
        Next i
    End With
    Sheet1.Range("A2").Resize(1000, 21).ClearContents
    Sheet1.Range("A2").Resize(k, UBound(Arr, 2)) = dArr
    Application.ScreenUpdating = True
End Sub

happyghost2000 · 12/9/19

LamNA đã viết:
Tiếp sức tý nữa coi như cũng được 75% giải hết ra vì sức có hạn
Đoạn này coi như đã lấy được dự liệu trong file .txt

Tiếp theo sẽ lọc trùng nhưng code này chỉ lọc trùng 1 cột (a) chưa phải là 3 cột (b,c,d), tạm thời chưa tìm ra giải pháp bạn chờ anh chị khác hỗ trợ thêm cho bạn nhé

Cám ơn bạn nhiều . Vì lọc trùng 1 cột (a) nên số liệu cộng dồn không ổn llắm .

VetMini · 12/9/19

Lè lẹ vào cái này, may ra còn kịp.

[TPHCM] [Cafe Excel] Khám phá sức mạnh của PowerQuery 15/9

Thân chào các thành viên ở TPHCM và khu vực lân cận, Power Query là một trong nhóm các công cụ rất mạnh mà Microsoft đã cho vào bộ office trong vài năm gần đây. Thế nhưng việc khai thác sức mạnh của nó vẫn đang là vấn đề với nhiều người dùng. Để giúp các những người chưa biết đến công cụ này...

www.giaiphapexcel.com

happyghost2000 · 12/9/19

VetMini đã viết:
Lè lẹ vào cái này, may ra còn kịp.

Có giải pháp nào không bạn ?

VetMini · 13/9/19

happyghost2000 đã viết:
Có giải pháp nào không bạn ?

Đã vào chưa?

happyghost2000 · 13/9/19

@LamNA mình có 3 file text giống chạy code .
2 file chạy OK đến file thứ 3 báo lỗi .
Lỗi này xử lý sao bạn . Giúp mình

LamNA · 13/9/19

happyghost2000 đã viết:
@LamNA mình có 3 file text giống chạy code .
2 file chạy OK đến file thứ 3 báo lỗi .
Lỗi này xử lý sao bạn . Giúp mình

View attachment 224160

Chắc tiêu đề bị gì đó chưa mò ra nhưng cứ lấy tiêu đề của file 1 hoặc 2 dán qua file 3 xem được không?

Mã:

H’ö,»•iº°ÄÞ,‰ÁH,»•i–¼Ì      ,‘OŒŽ––   ,Žó“ü     ,Žó“ü•Ô•i ,•¥o     ,•¥o•Ô•i ,ÝŒÉ     ,Hê,×²Ý

happyghost2000 · 13/9/19

happyghost2000 đã viết:
@LamNA mình có 3 file text giống chạy code .
2 file chạy OK đến file thứ 3 báo lỗi .
Lỗi này xử lý sao bạn . Giúp mình

View attachment 224160

Mình xử lý được rồi . Lỗi Save file .
Giờ xử lý lỗi công dồn

Bài đã được tự động gộp: 13/9/19

LamNA đã viết:
Chắc tiêu đề bị gì đó chưa mò ra nhưng cứ lấy tiêu đề của file 1 hoặc 2 dán qua file 3 xem được không?

Mã:

H’ö,»•iº°ÄÞ,‰ÁH,»•i–¼Ì ,‘OŒŽ–– ,Žó“ü ,Žó“ü•Ô•i ,•¥o ,•¥o•Ô•i ,ÝŒÉ ,Hê,×²Ý

Lỗi save file . mở file Text ra save as lại tên khac lại bình thường

LamNA · 13/9/19

happyghost2000 đã viết:
Mình xử lý được rồi . Lỗi Save file .
Giờ xử lý lỗi công dồn

Bài đã được tự động gộp: 13/9/19

Lỗi save file . mở file Text ra save as lại tên khac lại bình thường

Mà nếu tổng hợp được dữ liệu rồi thì pivot đi hình như được mà

LamNA · 13/9/19

happyghost2000 đã viết:
@LamNA mình có 3 file text giống chạy code .
2 file chạy OK đến file thứ 3 báo lỗi .
Lỗi này xử lý sao bạn . Giúp mình

View attachment 224160

Pivot để tính tổng

Giúp em Công thức Coppy bằng VBA

Thành viên chính thức

File đính kèm

Thành viên hoạt động

Thành viên mới

Thành viên hoạt động

Thành viên mới

Thành viên hoạt động

Thành viên chính thức

Thành viên chính thức

Thành viên tích cực

File đính kèm

Thành viên chính thức

Thành viên tích cực

File đính kèm

Thành viên chính thức

Ăn cùng góc phố

Thành viên chính thức

Ăn cùng góc phố

Thành viên chính thức

File đính kèm

Thành viên tích cực

Thành viên chính thức

Thành viên tích cực

Thành viên tích cực

File đính kèm

Đếm ngược thời gian