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

Liên hệ QC
T

thuhien.st

Thành viên chính thức
Tham gia
28/10/15
Bài viết
58
Được thích
9
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

  • ss.xlsx
    10.6 KB · Đọc: 12
thuhien.st đã viết:
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 ạ.
Nhấp chuột vào đây để mở rộng...
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.
 
thuhien.st đã viết:
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 ạ.
Nhấp chuột vào đây để mở rộng...
Đơ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
 
thuhien.st đã viết:
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 ạ.
Nhấp chuột vào đây để mở rộng...
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

  • ss (1).xlsm
    20.4 KB · Đọc: 6
snow25 đã viết:
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
Nhấp chuột vào đây để mở rộng...
snow25 đã viết:
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
Nhấp chuột vào đây để mở rộng...
Nếu sheet TH chưa họ tên và tiêu đề tháng thì sao bạn
 
HieuCD đã viết:
Nếu sheet TH chưa họ tên và tiêu đề tháng thì sao bạn
Nhấp chuột vào đây để mở rộng...
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

  • ss (1).xlsm
    20.4 KB · Đọc: 9
snow25 đã viết:
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
Nhấp chuột vào đây để mở rộng...
Hay lắm, chỉ cần chỉnh lại 1 chút để các con số không giống nhau là ổn
 
thuhien.st đã viết:
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
Nhấp chuột vào đây để mở rộng...
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

  • ss.xlsb
    23.4 KB · Đọc: 4
trongloc đã viết:
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
Nhấp chuột vào đây để mở rộng...
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:

snow25 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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 ạ
 
trongloc đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
 
thuhien.st đã viết:
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
Nhấp chuột vào đây để mở rộng...

Đâ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

  • Huong dan record.xlsx
    205.4 KB · Đọc: 4
  • ss.xlsb
    50.1 KB · Đọc: 8
trongloc đã viết:
Đâ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é
Nhấp chuột vào đây để mở rộng...
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
 
snow25 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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 ạ :)
 
trongloc đã viết:
Đâ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é
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn nhiều lắm lắm ấy!
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

P
HÀM SUBTOTAL BỊ #VALUE
Trả lời
2
Đọc
48
phantuancauvan
P
phanmoi688
[Xin nhờ giúp đỡ] Cách đối chiếu dữ liệu giữa hai biểu
    • Thích
2
Trả lời
28
Đọc
395
VetMini
V
tby211
Lỗi 1004 vba khi tách file trắc nghiệm sang excel
Trả lời
0
Đọc
25
tby211
tby211
NguyenthiH
  • Question
Code lấy dữ liệu cho sheet!TonDau.
Trả lời
6
Đọc
152
NguyenthiH
NguyenthiH
test1986
  • Question
HELP! Sử dụng combobox để cập nhật dữ liệu trong file Excel
Trả lời
17
Đọc
509
ngochienbmt
N
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

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

Back
Top Bottom