Viết code thay thế hàm INDEX & MATCH lấy dữ liệu tất cả các sheet (2 người xem)

  • Thread starter Thread starter lhthai
  • Ngày gửi Ngày gửi
Elx 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)
L

lhthai

Thành viên thường trực
Tham gia
1/9/07
Bài viết
309
Được thích
27
Chào Các Anh GPE
Hiện file em chỉ sử dụng hàm INDEX & MATCH được có 1 sheet
Nay muốn đổi thành code để dò tìm tất cả các sheet
Các Anh xem file đính kèm.
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
For each wsName In Array(tên sheet1, tên sheet 2, ...)
... INDEX(WorkSheets(wsName).Range(...), MATCH(WorkSheets(wsName).Range(...)...)
Next wsName
 
Upvote 0
VetMini đã viết:
For each wsName In Array(tên sheet1, tên sheet 2, ...)
... INDEX(WorkSheets(wsName).Range(...), MATCH(WorkSheets(wsName).Range(...)...)
Next wsName
Nhấp chuột vào đây để mở rộng...
Có cách nào khác mà không cần gõ tên sheet không bạn
dữ liệu nhiều sheet chẳng lẻ mỗi lần thêm sheet hay đổi tên sheet đều sửa code
cám ơn bạn nhiều.
 
Upvote 0
Chưa ai giải đành phải chờ thôi!!!!!
 
Upvote 0
lhthai đã viết:
Có cách nào khác mà không cần gõ tên sheet không bạn
dữ liệu nhiều sheet chẳng lẻ mỗi lần thêm sheet hay đổi tên sheet đều sửa code
cám ơn bạn nhiều.
Nhấp chuột vào đây để mở rộng...

PHP: 
For Each ws In Worksheets
   If ws.Name <> "ABC" Then
      '......
   End If
Next
 
Upvote 0
lhthai đã viết:
Chưa ai giải đành phải chờ thôi!!!!!
Nhấp chuột vào đây để mở rộng...

Chờ thì phải chờ rồi nhưng đừng viết bài Spam như bài #4.
Có khi người đọc cố hiểu xem người viết muốn cái gì qua diễn đạt "không dễ hiểu như vầy".
Và còn nhiều lý do để số lượng đọc thì nhiều nhưng chưa ai trả lời bài viết.
--------------
Dựa vào cách đọc hiểu công thức trong cột G của bạn, tôi "mù mờ" hiểu là như vầy,
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, DK As String, Dic As Object, Tem As String, CoL As Long, Ws As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range([A14], [A14].End(xlDown)).Value
DK = [G12].Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 2)
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1)
    If Not Dic.exists(Tem) Then
        Dic.Add Tem, I
        dArr(I, 1) = 1
    Else
        dArr(Dic.Item(Tem), 1) = dArr(Dic.Item(Tem), 1) + 1
    End If
Next I
For Each Ws In Worksheets
    If Ws.Name <> "KH" Then
        CoL = Ws.[J4].End(xlToRight).Column - 1
        sArr = Ws.Range(Ws.[B4], Ws.[B65536].End(xlUp)).Resize(, CoL).Value
        For I = 7 To UBound(sArr, 1)
            If sArr(I, 1) = DK Then
                For J = 9 To UBound(sArr, 2)
                    Tem = sArr(1, J)
                    If Dic.exists(Tem) Then dArr(Dic.Item(Tem), 2) = sArr(I, J)
                Next J
            End If
        Next I
    End If
Next Ws
[F14].Resize(UBound(dArr, 1), 2) = dArr
Set Dic = Nothing
End Sub
Bạn xem trong file, Thay đổi ô G12 để xem kết quả.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Ba Tê đã viết:
Chờ thì phải chờ rồi nhưng đừng viết bài Spam như bài #4.
Có khi người đọc cố hiểu xem người viết muốn cái gì qua diễn đạt "không dễ hiểu như vầy".
Và còn nhiều lý do để số lượng đọc thì nhiều nhưng chưa ai trả lời bài viết.
--------------
Dựa vào cách đọc hiểu công thức trong cột G của bạn, tôi "mù mờ" hiểu là như vầy,
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, DK As String, Dic As Object, Tem As String, CoL As Long, Ws As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range([A14], [A14].End(xlDown)).Value
DK = [G12].Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 2)
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1)
    If Not Dic.exists(Tem) Then
        Dic.Add Tem, I
        dArr(I, 1) = 1
    Else
        dArr(Dic.Item(Tem), 1) = dArr(Dic.Item(Tem), 1) + 1
    End If
Next I
For Each Ws In Worksheets
    If Ws.Name <> "KH" Then
        CoL = Ws.[J4].End(xlToRight).Column - 1
        sArr = Ws.Range(Ws.[B4], Ws.[B65536].End(xlUp)).Resize(, CoL).Value
        For I = 7 To UBound(sArr, 1)
            If sArr(I, 1) = DK Then
                For J = 9 To UBound(sArr, 2)
                    Tem = sArr(1, J)
                    If Dic.exists(Tem) Then dArr(Dic.Item(Tem), 2) = sArr(I, J)
                Next J
            End If
        Next I
    End If
Next Ws
[F14].Resize(UBound(dArr, 1), 2) = dArr
Set Dic = Nothing
End Sub
Bạn xem trong file, Thay đổi ô G12 để xem kết quả.
Nhấp chuột vào đây để mở rộng...
Anh Ba Te có thể hổ trợ em lần nữa nha
Em cần dò tìm kế quả cột G thôi không cần điếm số lượng ở cột F
Mã: 
[COLOR=#007700][FONT=monospace]For [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Each Ws In Worksheets
    [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Ws[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Name [/FONT][/COLOR][COLOR=#007700][FONT=monospace]<> [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"KH" [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Then
        CoL [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Ws[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]J4[/FONT][/COLOR][COLOR=#007700][FONT=monospace]].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]End[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]xlToRight[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Column [/FONT][/COLOR][COLOR=#007700][FONT=monospace]- [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1
        sArr [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Ws[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Range[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Ws[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]B4[/FONT][/COLOR][COLOR=#007700][FONT=monospace]], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Ws[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]B65536[/FONT][/COLOR][COLOR=#007700][FONT=monospace]].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]End[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]xlUp[/FONT][/COLOR][COLOR=#007700][FONT=monospace])).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Resize[/FONT][/COLOR][COLOR=#007700][FONT=monospace](, [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]CoL[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Value
        [/FONT][/COLOR][COLOR=#007700][FONT=monospace]For [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]I [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]7 To UBound[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
            If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]I[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) = [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]DK Then
                [/FONT][/COLOR][COLOR=#007700][FONT=monospace]For [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]J [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]9 To UBound[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]2[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
                    [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Tem [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]J[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
                    If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dic[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]exists[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Tem[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Then dArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dic[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Item[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Tem[/FONT][/COLOR][COLOR=#007700][FONT=monospace]), [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]2[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) = [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]I[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]J[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
                [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Next J
            End [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If
        [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Next I
    End [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If
[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Next Ws
[/FONT][/COLOR][COLOR=#007700][FONT=monospace][[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]F14[/FONT][/COLOR][COLOR=#007700][FONT=monospace]].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Resize[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]UBound[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]dArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace]), [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]2[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) = [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]dArr
Set Dic [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Nothing
End Sub
[/FONT][/COLOR]
 
Upvote 0
lhthai đã viết:
Anh Ba Te có thể hổ trợ em lần nữa nha
Em cần dò tìm kế quả cột G thôi không cần điếm số lượng ở cột F
Mã: 
[COLOR=#007700][FONT=monospace]For [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Each Ws In Worksheets
    [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Ws[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Name [/FONT][/COLOR][COLOR=#007700][FONT=monospace]<> [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"KH" [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Then
        CoL [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Ws[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]J4[/FONT][/COLOR][COLOR=#007700][FONT=monospace]].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]End[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]xlToRight[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Column [/FONT][/COLOR][COLOR=#007700][FONT=monospace]- [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1
        sArr [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Ws[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Range[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Ws[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]B4[/FONT][/COLOR][COLOR=#007700][FONT=monospace]], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Ws[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]B65536[/FONT][/COLOR][COLOR=#007700][FONT=monospace]].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]End[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]xlUp[/FONT][/COLOR][COLOR=#007700][FONT=monospace])).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Resize[/FONT][/COLOR][COLOR=#007700][FONT=monospace](, [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]CoL[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Value
        [/FONT][/COLOR][COLOR=#007700][FONT=monospace]For [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]I [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]7 To UBound[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
            If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]I[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) = [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]DK Then
                [/FONT][/COLOR][COLOR=#007700][FONT=monospace]For [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]J [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]9 To UBound[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]2[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
                    [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Tem [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]J[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
                    If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dic[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]exists[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Tem[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Then dArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dic[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Item[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Tem[/FONT][/COLOR][COLOR=#007700][FONT=monospace]), [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]2[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) = [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]I[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]J[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
                [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Next J
            End [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If
        [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Next I
    End [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If
[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Next Ws
[/FONT][/COLOR][COLOR=#007700][FONT=monospace][[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]F14[/FONT][/COLOR][COLOR=#007700][FONT=monospace]].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Resize[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]UBound[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]dArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace]), [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]2[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) = [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]dArr
Set Dic [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Nothing
End Sub
[/FONT][/COLOR]
Nhấp chuột vào đây để mở rộng...

Sheets("KH") thay cái cũ bằng cái này:
PHP: 
Private Sub CommandButton1_Click()
Dim sArr(), dArr(1 To 50000, 1 To 5), Ws As Worksheet, I As Long, J As Long, K As Long
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "KH" Then
        sArr = Ws.Range(Ws.[J4], Ws.[J4].End(xlToRight)).Resize(5).Value
        For J = 1 To UBound(sArr, 2)
            K = K + 1
            For I = 1 To 5
                dArr(K, I) = sArr(I, J)
            Next I
        Next J
    End If
Next Ws
Sheets("KH").[A14:E50000].ClearContents
Sheets("KH").[A14].Resize(K, 5) = dArr
End Sub
Trong Module1 thay cái cũ bằng cái này:
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, DK As String, Dic As Object, Tem As String, CoL As Long, Ws As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range([A14], [A14].End(xlDown)).Value
DK = [G12].Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 1)
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1)
    If Not Dic.exists(Tem) Then Dic.Add Tem, I
Next I
For Each Ws In Worksheets
    If Ws.Name <> "KH" Then
        CoL = Ws.[J4].End(xlToRight).Column - 1
        sArr = Ws.Range(Ws.[B4], Ws.[B65536].End(xlUp)).Resize(, CoL).Value
        For I = 7 To UBound(sArr, 1)
            If sArr(I, 1) = DK Then
                For J = 9 To UBound(sArr, 2)
                    Tem = sArr(1, J)
                    If Dic.exists(Tem) Then dArr(Dic.Item(Tem), 1) = sArr(I, J)
                Next J
            End If
        Next I
    End If
Next Ws
[G14:G50000].ClearContents
[G14].Resize(UBound(dArr, 1)) = dArr
Set Dic = Nothing
End Sub
Viết xong cũng phải đọc sơ lại xem mình đã viết cái gì trước khi gởi lên cho mọi người đọc nhé. Nếu thấy sai sót phải chỉnh sửa lại ngay.
 
Lần chỉnh sửa cuối:
Upvote 0
Cám ơn Anh Rất nhiều
Anh cho em hỏi thêm nha
Tại sao copy code vào file của anh gửi thì nó chạy còn vào file của em thì nó không chạy
Trường hợp em thêm 3 điều kiện nữa thì sữa như thế nào
DK = [G12:J12].Value

 
Upvote 0
lhthai đã viết:
Cám ơn Anh Rất nhiều
Anh cho em hỏi thêm nha
Tại sao copy code vào file của anh gửi thì nó chạy còn vào file của em thì nó không chạy
Trường hợp em thêm 3 điều kiện nữa thì sữa như thế nào
DK = [G12:J12].Value
Nhấp chuột vào đây để mở rộng...
chắc anh BaTe chạy mất dép quá, bạn chạy không được có nghĩa là
File của bạn bố trí không khớp với lại code của anh BaTe(lập trình VBA dựa vào cách bố trí của bảng tính thì mới quyết định được code như thế nào)
Thứ 2 bạn phải tìm ra các điều kiện lọc 1 lần cho người ta viết, chứ viết lắc nhắc lắc nhắc thêm đk,đk... thì người viết cũng nản
 
Upvote 0
lhthai đã viết:
Cám ơn Anh Rất nhiều
Anh cho em hỏi thêm nha
Tại sao copy code vào file của anh gửi thì nó chạy còn vào file của em thì nó không chạy
Trường hợp em thêm 3 điều kiện nữa thì sữa như thế nào
DK = [G12:J12].Value
Nhấp chuột vào đây để mở rộng...
Em tìm ra rồi thì ra thiếu đoạn code này
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$G$12" Then GPE
End Sub
 
Upvote 0
Lộc dữ liệu tất cả các sheet qua sheet Cell

Mình muốn lộc dữ liệu tất cả các sheet qua sheet Cell
Kết quả trả về các ô em tô màu vàng(trong file dinh kèm)
Các anh xem file đính kèm
 
Upvote 0
Nhờ các anh chỉ dùm đoạn code này cần sửa chỗ nào chạy được
Mã: 
rivate Sub CommandButton1_Click()
Dim sArr(), dArr(), I As Long, J As Long, DK As String, Dic As Object, Tem As String, CoL As Long, Ws As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range([B10], [B10].End(xlDown)).Value
[COLOR=#ff0000]DK = [E4].Value[/COLOR]
ReDim dArr(1 To UBound(sArr, 1), 1 To 1)
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1)
    If Not Dic.exists(Tem) Then Dic.Add Tem, I
Next I
For Each Ws In Worksheets
    If Ws.Name <> "KH" And Ws.Name <> "CELL" Then
        CoL = Ws.[J4].End(xlToRight).Column - 1
        sArr = Ws.Range(Ws.[B4], Ws.[B65536].End(xlUp)).Resize(, CoL).Value
        For I = 7 To UBound(sArr, 1)
            If sArr(I, 1) = DK Then
                For J = 9 To UBound(sArr, 2)
                    Tem = sArr(1, J)
                    If Dic.exists(Tem) Then dArr(Dic.Item(Tem), 1) = sArr(I, J)
                Next J
            End If
        Next I
    End If
Next Ws
[COLOR=#ff0000][E10].Resize(UBound(dArr, 1)) = dArr[/COLOR]
Set Dic = Nothing
End Sub
 
Upvote 0
lhthai đã viết:
Nhờ các anh chỉ dùm đoạn code này cần sửa chỗ nào chạy được
Mã: 
rivate Sub CommandButton1_Click()
Dim sArr(), dArr(), I As Long, J As Long, DK As String, Dic As Object, Tem As String, CoL As Long, Ws As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range([B10], [B10].End(xlDown)).Value
[COLOR=#ff0000]DK = [E4].Value[/COLOR]
ReDim dArr(1 To UBound(sArr, 1), 1 To 1)
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1)
    If Not Dic.exists(Tem) Then Dic.Add Tem, I
Next I
For Each Ws In Worksheets
    If Ws.Name <> "KH" And Ws.Name <> "CELL" Then
        CoL = Ws.[J4].End(xlToRight).Column - 1
        sArr = Ws.Range(Ws.[B4], Ws.[B65536].End(xlUp)).Resize(, CoL).Value
        For I = 7 To UBound(sArr, 1)
            If sArr(I, 1) = DK Then
                For J = 9 To UBound(sArr, 2)
                    Tem = sArr(1, J)
                    If Dic.exists(Tem) Then dArr(Dic.Item(Tem), 1) = sArr(I, J)
                Next J
            End If
        Next I
    End If
Next Ws
[COLOR=#ff0000][E10].Resize(UBound(dArr, 1)) = dArr[/COLOR]
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Chạy macro ghi lại copy từng cái qua
Mã: 
Private Sub CommandButton1_Click()
Dim Sh As Worksheet
    For Each Sh In Worksheets
    If Sh.Name <> "KH" And Sh.Name <> "CELL" Then
        Sh.[J3:IV65000].Sort Sh.[3:3], 1, Orientation:=xlLeftToRight
    End If
Next
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
lhthai đã viết:
Mình muốn lộc dữ liệu tất cả các sheet qua sheet Cell
Kết quả trả về các ô em tô màu vàng(trong file dinh kèm)
Các anh xem file đính kèm
Nhấp chuột vào đây để mở rộng...

Bấm nút Update trong sheet GPE thử xem.
Nhập lại từ E4:T4 những gì bạn muốn, tôi nhập thủ công để thử code thôi.
Dữ liệu lớn nên giảm bớt màu mè, hình vẽ, Conditional Formatting... Cần thiết lắm thì sử dụng đúng trong phạm vi dữ liệu thôi, sao lại tô màu cả cột, cả dòng "bao la" cho phí của.
 

File đính kèm

Upvote 0
Ba Tê đã viết:
Bấm nút Update trong sheet GPE thử xem.
Nhập lại từ E4:T4 những gì bạn muốn, tôi nhập thủ công để thử code thôi.
Dữ liệu lớn nên giảm bớt màu mè, hình vẽ, Conditional Formatting... Cần thiết lắm thì sử dụng đúng trong phạm vi dữ liệu thôi, sao lại tô màu cả cột, cả dòng "bao la" cho phí của.
Nhấp chuột vào đây để mở rộng...
Bài này hay nè copy về để sau này có cần để dùng
 
Lần chỉnh sửa cuối:
Upvote 0
Ba Tê đã viết:
Bấm nút Update trong sheet GPE thử xem.
Nhập lại từ E4:T4 những gì bạn muốn, tôi nhập thủ công để thử code thôi.
Dữ liệu lớn nên giảm bớt màu mè, hình vẽ, Conditional Formatting... Cần thiết lắm thì sử dụng đúng trong phạm vi dữ liệu thôi, sao lại tô màu cả cột, cả dòng "bao la" cho phí của.
Nhấp chuột vào đây để mở rộng...
Không biết nói gì hơn ngoài câu cám ơn rất nhiều.
 
Upvote 0
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

L
Tính thời gian làm việc thực tế
Trả lời
66
Đọc
14K
YenTon
Y
H
Chia sẻ file in Phiếu điều tra PCGD
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
13
Đọc
630
Phuong7686
P
GPE-Trợ Lý
  • Dán lên cao
[KHẨN] HƯỚNG VỀ ĐỒNG BÀO CHỊU ẢNH HƯỞNG CỦA BÃO YAGI - BẢO YÊN, LÀO CAI
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
91
Đọc
14K
SA_DQ
SA_DQ
SA_DQ
Copilot bình luận về một ván cờ vua
    • Thích
Trả lời
6
Đọc
409
SA_DQ
SA_DQ
92nguyenthanh
  • Question Question
Vba cho file nhập xuất kho
Trả lời
4
Đọc
110
HUONGHCKT
H
C
Fix lỗi Application.InputBox Type:=8
    • Cười
Trả lời
25
Đọc
618
ptm0412
ptm0412
GPE-Trợ Lý
[GPE] TALK SHOW 08: GIẢI QUYẾT VẤN ĐỀ TỐI ƯU HÓA TRONG EXCEL VỚI CÔNG CỤ SOLVER
    • Thích
    • Cảm ơn
Trả lời
4
Đọc
3K
DuongLeHung
D
Gà Công Nghệ
Chế độ chính sách cho giáo viên mầm non giữ trẻ khuyết tật
Trả lời
1
Đọc
58
vanle33
vanle33
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
56
Đọc
22K
dunghtgiga
dunghtgiga
L
  • Question Question
Viết code tìm kiếm các file trong Folder
Trả lời
40
Đọc
12K
lan nguyen0987
L
P
Hyperlink_Cách chuyển cả thư mục và file tổng hợp sang máy khác không bị lỗi
Trả lời
5
Đọc
109
phongvanvu
P
HeSanbi
Tiện ích Web: Tự động nhấn nút "Bỏ qua" quảng cáo Youtube
    • Thích
    • Yêu thích
Trả lời
14
Đọc
1K
ongke0711
ongke0711
ptm0412
Quá tin tưởng vào AI các thể loại
    • Cười
Trả lời
4
Đọc
218
Maika8008
Maika8008
A
  • Question Question
Không tìm được lỗi code
Trả lời
6
Đọc
160
ptm0412
ptm0412
W
Tham chiếu theo chuỗi ký tự
Trả lời
8
Đọc
315
dungpham01
D
tritv.dad
Lấy dữ liệu từ folder các tờ khai thông quan để theo dõi hiệu suất công việc.
Trả lời
8
Đọc
287
BlueSphere
B
GPE-Trợ Lý
MỪNG NGÀY NHÀ GIÁO VIỆT NAM 20/11 (1 người xem)
    • Thích
Trả lời
0
Đọc
3K
GPE-Trợ Lý
GPE-Trợ Lý
SA_DQ
Xin chúc mừng các thầy cô giáo trên cộng đồng nhân 20/11
    • Thích
    • Yêu thích
Trả lời
1
Đọc
135
BuiQuangThuan
B
M
chuyển đổi số thành chữ
Trả lời
15
Đọc
371
dungpham01
D
V
Lỗi copy sheet: the name already exists.
Trả lời
7
Đọc
702
nghiabros
N
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