Tìm kiếm và điền tên còn thiếu

thuhien.st

Thành viên mới
Tham gia ngày
28 Tháng mười 2015
Bài viết
18
Thích
2
Điểm
165
#1
Em xin nhờ các chuyên gia giúp đỡ ạ. Em có book như đính kèm ạ, em phải điền số tiền ở sheet "tháng 1" "tháng 2" vào sheet "TH". Cách tìm và điền theo tên thì em đã được các chuyên gia giúp đỡ từ lần em hỏi trước, em lại phát sinh một vấn đề đó là tại sheet "TH" em chỉ có một số tên nhất định trong khi sheet "tháng 1" " tháng 2" lại có thêm những cái tên mà sheet "TH" không có. Các chuyên gia cho em hỏi có câu lệnh nào có thể giúp hiển thị được đầy đủ những tên có trong sheet "tháng 1" "tháng 2" hiển thị vào sheet "TH" ạ. Em cảm ơn ạ.
 

File đính kèm

snow25

Thành viên tích cực
Tham gia ngày
24 Tháng bảy 2018
Bài viết
1,166
Thích
861
Điểm
210
#2
Em xin nhờ các chuyên gia giúp đỡ ạ. Em có book như đính kèm ạ, em phải điền số tiền ở sheet "tháng 1" "tháng 2" vào sheet "TH". Cách tìm và điền theo tên thì em đã được các chuyên gia giúp đỡ từ lần em hỏi trước, em lại phát sinh một vấn đề đó là tại sheet "TH" em chỉ có một số tên nhất định trong khi sheet "tháng 1" " tháng 2" lại có thêm những cái tên mà sheet "TH" không có. Các chuyên gia cho em hỏi có câu lệnh nào có thể giúp hiển thị được đầy đủ những tên có trong sheet "tháng 1" "tháng 2" hiển thị vào sheet "TH" ạ. Em cảm ơn ạ.
Dùng VBA điền cho nhanh.Nhưng có 1 vấn đề là 2 người tên giống hệt nhau thì điền kiểu gì.Mà không phải chuyên gia có được không.
 

trongloc

Thành viên mới
Tham gia ngày
11 Tháng mười một 2007
Bài viết
15
Thích
6
Điểm
665
#3
Em xin nhờ các chuyên gia giúp đỡ ạ. Em có book như đính kèm ạ, em phải điền số tiền ở sheet "tháng 1" "tháng 2" vào sheet "TH". Cách tìm và điền theo tên thì em đã được các chuyên gia giúp đỡ từ lần em hỏi trước, em lại phát sinh một vấn đề đó là tại sheet "TH" em chỉ có một số tên nhất định trong khi sheet "tháng 1" " tháng 2" lại có thêm những cái tên mà sheet "TH" không có. Các chuyên gia cho em hỏi có câu lệnh nào có thể giúp hiển thị được đầy đủ những tên có trong sheet "tháng 1" "tháng 2" hiển thị vào sheet "TH" ạ. Em cảm ơn ạ.
Đơn giản nhất là bạn Record lại lệnh copy phần tên của sheet "Tháng 1" "Tháng 2" rồi Remove Duplicates là xong, không cần biết code VBA
 

tam888

Thành viên tích cực
Tham gia ngày
22 Tháng tám 2013
Bài viết
607
Thích
352
Điểm
435
#5
Đơn giản nhất là bạn Record lại lệnh copy phần tên của sheet "Tháng 1" "Tháng 2" rồi Remove Duplicates là xong, không cần biết code VBA
Cần chi ghi macro nữa, làm 1 lần là xong
Lần sau nếu tương tự thì làm giống vậy
 

snow25

Thành viên tích cực
Tham gia ngày
24 Tháng bảy 2018
Bài viết
1,166
Thích
861
Điểm
210
#7
Em xin nhờ các chuyên gia giúp đỡ ạ. Em có book như đính kèm ạ, em phải điền số tiền ở sheet "tháng 1" "tháng 2" vào sheet "TH". Cách tìm và điền theo tên thì em đã được các chuyên gia giúp đỡ từ lần em hỏi trước, em lại phát sinh một vấn đề đó là tại sheet "TH" em chỉ có một số tên nhất định trong khi sheet "tháng 1" " tháng 2" lại có thêm những cái tên mà sheet "TH" không có. Các chuyên gia cho em hỏi có câu lệnh nào có thể giúp hiển thị được đầy đủ những tên có trong sheet "tháng 1" "tháng 2" hiển thị vào sheet "TH" ạ. Em cảm ơn ạ.
Bạn xem file đính kèm.
Mã:
Sub diendulieu()
Dim arr, arr1, i As Long, j As Long, dic As Object, lr As Long, a As Long, b As Long, c As Integer
Dim sh As Worksheet
Set dic = CreateObject("scripting.dictionary")
With Sheets("TH")
    lr = .Range("B" & Rows.Count).End(xlUp).Row
    If lr < 2 Then Exit Sub
    arr = .Range("B1:D" & lr).Value
    For i = 2 To UBound(arr, 1)
        dic.Item(arr(i, 1)) = i
    Next i
    For i = 2 To UBound(arr, 2)
        dic.Item(arr(1, i)) = i
    Next i
End With
For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> "TH" Then
       a = sh.Range("B" & Rows.Count).End(xlUp).Row
       If a > 2 Then
          arr1 = sh.Range("B1:C" & a).Value
          c = dic.Item(arr1(1, 2))
          If c Then
             For i = 2 To UBound(arr1, 1)
                 b = dic.Item(arr1(i, 1))
                 If b Then
                    arr(b, c) = arr1(i, 2)
                 End If
             Next i
         End If
     End If
 End If
Next
With Sheets("TH")
     .Range("B1:D" & lr).Value = arr
End With
End Sub
 

File đính kèm

Tham gia ngày
6 Tháng một 2011
Bài viết
8,246
Thích
9,242
Điểm
560
#8

HieuCD

Thành viên gạo cội
Tham gia ngày
14 Tháng chín 2010
Bài viết
5,152
Thích
8,303
Điểm
560
#9
Bạn xem file đính kèm.
Mã:
Sub diendulieu()
Dim arr, arr1, i As Long, j As Long, dic As Object, lr As Long, a As Long, b As Long, c As Integer
Dim sh As Worksheet
Set dic = CreateObject("scripting.dictionary")
With Sheets("TH")
    lr = .Range("B" & Rows.Count).End(xlUp).Row
    If lr < 2 Then Exit Sub
    arr = .Range("B1:D" & lr).Value
    For i = 2 To UBound(arr, 1)
        dic.Item(arr(i, 1)) = i
    Next i
    For i = 2 To UBound(arr, 2)
        dic.Item(arr(1, i)) = i
    Next i
End With
For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> "TH" Then
       a = sh.Range("B" & Rows.Count).End(xlUp).Row
       If a > 2 Then
          arr1 = sh.Range("B1:C" & a).Value
          c = dic.Item(arr1(1, 2))
          If c Then
             For i = 2 To UBound(arr1, 1)
                 b = dic.Item(arr1(i, 1))
                 If b Then
                    arr(b, c) = arr1(i, 2)
                 End If
             Next i
         End If
     End If
End If
Next
With Sheets("TH")
     .Range("B1:D" & lr).Value = arr
End With
End Sub
Bạn xem file đính kèm.
Mã:
Sub diendulieu()
Dim arr, arr1, i As Long, j As Long, dic As Object, lr As Long, a As Long, b As Long, c As Integer
Dim sh As Worksheet
Set dic = CreateObject("scripting.dictionary")
With Sheets("TH")
    lr = .Range("B" & Rows.Count).End(xlUp).Row
    If lr < 2 Then Exit Sub
    arr = .Range("B1:D" & lr).Value
    For i = 2 To UBound(arr, 1)
        dic.Item(arr(i, 1)) = i
    Next i
    For i = 2 To UBound(arr, 2)
        dic.Item(arr(1, i)) = i
    Next i
End With
For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> "TH" Then
       a = sh.Range("B" & Rows.Count).End(xlUp).Row
       If a > 2 Then
          arr1 = sh.Range("B1:C" & a).Value
          c = dic.Item(arr1(1, 2))
          If c Then
             For i = 2 To UBound(arr1, 1)
                 b = dic.Item(arr1(i, 1))
                 If b Then
                    arr(b, c) = arr1(i, 2)
                 End If
             Next i
         End If
     End If
End If
Next
With Sheets("TH")
     .Range("B1:D" & lr).Value = arr
End With
End Sub
Nếu sheet TH chưa họ tên và tiêu đề tháng thì sao bạn
 

snow25

Thành viên tích cực
Tham gia ngày
24 Tháng bảy 2018
Bài viết
1,166
Thích
861
Điểm
210
#10
Nếu sheet TH chưa họ tên và tiêu đề tháng thì sao bạn
Anh xem có đúng không nhé.
Mã:
Sub diendulieu()
Const ten_sheet As String = "TH"
Dim arr, arr1, i As Long, j As Long, dic As Object, lr As Long, a As Long, b As Long, c As Integer
Dim sh As Worksheet
Set dic = CreateObject("scripting.dictionary")
ReDim arr1(1 To 1000, 1 To 12)
     arr1(1, 1) = "STT": arr1(1, 2) = "HO VA TEN"
     a = 1: c = 2
For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> ten_sheet Then
       lr = sh.Range("B" & Rows.Count).End(xlUp).Row
       If lr > 2 Then
          arr = sh.Range("B1:C" & lr).Value
          c = c + 1
          arr1(1, c) = arr(1, 2)
          For i = 2 To UBound(arr, 1)
              If Not dic.exists(arr(i, 1)) Then
                 a = a + 1: arr1(a, 1) = a - 1
                 arr1(a, 2) = arr(i, 1): arr1(a, c) = arr(i, 2)
                 dic.Add arr(i, 1), a
              Else
                 b = dic.Item(arr(i, 1))
                 arr1(b, c) = arr(i, 2)
              End If
          Next i
     End If
 End If
Next
With Sheets(ten_sheet)
    .Cells.ClearContents
    If a Then .Range("A1").Resize(a, c).Value = arr1
End With
End Sub
 

File đính kèm

HieuCD

Thành viên gạo cội
Tham gia ngày
14 Tháng chín 2010
Bài viết
5,152
Thích
8,303
Điểm
560
#11
Anh xem có đúng không nhé.
Mã:
Sub diendulieu()
Const ten_sheet As String = "TH"
Dim arr, arr1, i As Long, j As Long, dic As Object, lr As Long, a As Long, b As Long, c As Integer
Dim sh As Worksheet
Set dic = CreateObject("scripting.dictionary")
ReDim arr1(1 To 1000, 1 To 12)
     arr1(1, 1) = "STT": arr1(1, 2) = "HO VA TEN"
     a = 1: c = 2
For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> ten_sheet Then
       lr = sh.Range("B" & Rows.Count).End(xlUp).Row
       If lr > 2 Then
          arr = sh.Range("B1:C" & lr).Value
          c = c + 1
          arr1(1, c) = arr(1, 2)
          For i = 2 To UBound(arr, 1)
              If Not dic.exists(arr(i, 1)) Then
                 a = a + 1: arr1(a, 1) = a - 1
                 arr1(a, 2) = arr(i, 1): arr1(a, c) = arr(i, 2)
                 dic.Add arr(i, 1), a
              Else
                 b = dic.Item(arr(i, 1))
                 arr1(b, c) = arr(i, 2)
              End If
          Next i
     End If
End If
Next
With Sheets(ten_sheet)
    .Cells.ClearContents
    If a Then .Range("A1").Resize(a, c).Value = arr1
End With
End Sub
Hay lắm, chỉ cần chỉnh lại 1 chút để các con số không giống nhau là ổn
 

trongloc

Thành viên mới
Tham gia ngày
11 Tháng mười một 2007
Bài viết
15
Thích
6
Điểm
665
#12
Bạn có thể hướng dẫn cụ thể giùm mình không! Mình hơi cà rốt phần record
Mình làm ví dụ Record cho bạn nhé, nếu thay tên Sheet thì bạn phải sửa trong macro, cái này khá dễ làm, còn code thì các cao thủ đã post rồi mà hơi khó hiểu
 

File đính kèm

thuhien.st

Thành viên mới
Tham gia ngày
28 Tháng mười 2015
Bài viết
18
Thích
2
Điểm
165
#13
Mình làm ví dụ Record cho bạn nhé, nếu thay tên Sheet thì bạn phải sửa trong macro, cái này khá dễ làm, còn code thì các cao thủ đã post rồi mà hơi khó hiểu
Mình cảm ơn bạn, nhưng phiền bạn đã giúp thì giúp cho chót có thể hướng dẫn chi tiết từng bước giúp mình không. Mình coi sheet bạn gửi thì thấy được kết quả trả về luôn. Đây chỉ là ví dụ ngắn gọn một số người thôi chứ đơn vị bên mình hơn 500 CBNV, tháng nào cũng thêm mới, nghỉ việc liên tục nên nhỡ bạn hướng dẫn cụ thể giúp mình với. Mình cảm ơn
Bài đã được tự động gộp:

Anh xem có đúng không nhé.
Mã:
Sub diendulieu()
Const ten_sheet As String = "TH"
Dim arr, arr1, i As Long, j As Long, dic As Object, lr As Long, a As Long, b As Long, c As Integer
Dim sh As Worksheet
Set dic = CreateObject("scripting.dictionary")
ReDim arr1(1 To 1000, 1 To 12)
     arr1(1, 1) = "STT": arr1(1, 2) = "HO VA TEN"
     a = 1: c = 2
For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> ten_sheet Then
       lr = sh.Range("B" & Rows.Count).End(xlUp).Row
       If lr > 2 Then
          arr = sh.Range("B1:C" & lr).Value
          c = c + 1
          arr1(1, c) = arr(1, 2)
          For i = 2 To UBound(arr, 1)
              If Not dic.exists(arr(i, 1)) Then
                 a = a + 1: arr1(a, 1) = a - 1
                 arr1(a, 2) = arr(i, 1): arr1(a, c) = arr(i, 2)
                 dic.Add arr(i, 1), a
              Else
                 b = dic.Item(arr(i, 1))
                 arr1(b, c) = arr(i, 2)
              End If
          Next i
     End If
End If
Next
With Sheets(ten_sheet)
    .Cells.ClearContents
    If a Then .Range("A1").Resize(a, c).Value = arr1
End With
End Sub
Em xin cảm ơn ạ, mặc dù VBA em chưa được học nhưng em sẽ cố gắng nghiên cứu ạ
 

thuhien.st

Thành viên mới
Tham gia ngày
28 Tháng mười 2015
Bài viết
18
Thích
2
Điểm
165
#14
Mình làm ví dụ Record cho bạn nhé, nếu thay tên Sheet thì bạn phải sửa trong macro, cái này khá dễ làm, còn code thì các cao thủ đã post rồi mà hơi khó hiểu
Mình cảm ơn bạn, nhưng phiền bạn đã giúp thì giúp cho chót có thể hướng dẫn chi tiết từng bước giúp mình không. Mình coi sheet bạn gửi thì thấy được kết quả trả về luôn. Đây chỉ là ví dụ ngắn gọn một số người thôi chứ đơn vị bên mình hơn 500 CBNV, tháng nào cũng thêm mới, nghỉ việc liên tục nên nhỡ bạn hướng dẫn cụ thể giúp mình với. Mình cảm ơn
 

trongloc

Thành viên mới
Tham gia ngày
11 Tháng mười một 2007
Bài viết
15
Thích
6
Điểm
665
#15
Mình cảm ơn bạn, nhưng phiền bạn đã giúp thì giúp cho chót có thể hướng dẫn chi tiết từng bước giúp mình không. Mình coi sheet bạn gửi thì thấy được kết quả trả về luôn. Đây chỉ là ví dụ ngắn gọn một số người thôi chứ đơn vị bên mình hơn 500 CBNV, tháng nào cũng thêm mới, nghỉ việc liên tục nên nhỡ bạn hướng dẫn cụ thể giúp mình với. Mình cảm ơn
Đây nhé bạn, file của bạn mình làm 2 module luôn rồi, module 2 là thuần record (sửa 1 chút), module 1 là kết hợp code với record dùng đc cả trường hợp insert thêm tháng 3-12 và trong giới hạn 1tr dòng nên bạn dùng thoải mái nhé
 

File đính kèm

snow25

Thành viên tích cực
Tham gia ngày
24 Tháng bảy 2018
Bài viết
1,166
Thích
861
Điểm
210
#16
Đây nhé bạn, file của bạn mình làm 2 module luôn rồi, module 2 là thuần record (sửa 1 chút), module 1 là kết hợp code với record dùng đc cả trường hợp insert thêm tháng 3-12 và trong giới hạn 1tr dòng nên bạn dùng thoải mái nhé
Bỏ cái cập nhập màn hình đi bạn.Chạy nó loạn quá.Nhiều chắc nháy tới mai.Hihi.
Mã:
 sub ...
Application.ScreenUpdating = False
code ...
Application.ScreenUpdating = True
end sub
 

trongloc

Thành viên mới
Tham gia ngày
11 Tháng mười một 2007
Bài viết
15
Thích
6
Điểm
665
#17
Bỏ cái cập nhập màn hình đi bạn.Chạy nó loạn quá.Nhiều chắc nháy tới mai.Hihi.
Mã:
 sub ...
Application.ScreenUpdating = False
code ...
Application.ScreenUpdating = True
end sub
Cái này em test trên file mẫu ít nên không cần, 12 sheets thì chắc thêm vào bác ạ :)
 

thuhien.st

Thành viên mới
Tham gia ngày
28 Tháng mười 2015
Bài viết
18
Thích
2
Điểm
165
#18
Đây nhé bạn, file của bạn mình làm 2 module luôn rồi, module 2 là thuần record (sửa 1 chút), module 1 là kết hợp code với record dùng đc cả trường hợp insert thêm tháng 3-12 và trong giới hạn 1tr dòng nên bạn dùng thoải mái nhé
Cảm ơn bạn nhiều lắm lắm ấy!
 
Top