Tìm kiếm và điền tên còn thiếu (1 người xem)

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)
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

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

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

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

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

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

A
NHỜ ANH CHỊ GIÚP EM CÂU LỆNH NÀY VỚI Ạ (2 người xem)
Trả lời
1
Đọc
60
ongke0711
ongke0711
P
Hỏi về cách dò tìm từ dưới lên trên, dò tìm trong 2 bảng
Trả lời
6
Đọc
123
pqdowntailieu3
P
H
Chuyển file *xml hóa đơn điện tử sang excel (1 người xem)
    • Thích
Trả lời
4
Đọc
149
htrunga2
H
K
Lọc một mã sản phẩm có nhiều đơn giá thành một file riêng
Trả lời
2
Đọc
76
ketoansb123
K
D
Nhờ trợ giúp xác định thứ tự của các từ và cụm từ trong 1 chuỗi văn bản. (1 người xem)
Trả lời
10
Đọc
253
Phuocam
Phuocam
P
Xin tư vấn về cách tạo bảng quản lý vải (1 người xem)
    • Cười
Trả lời
13
Đọc
162
Hai Lúa Miền Tây
Hai Lúa Miền Tây
1
Vướng mắc về hàm lấy tên đăng nhập máy tính ạ
Trả lời
19
Đọc
547
thuytrangbp28
T
Trungvt3
Công thức trả về định dạng không như mong muốn và viết phân số trong 1 ô.
Trả lời
6
Đọc
184
Trungvt3
Trungvt3
H
  • Question Question
Tô đậm tiêu đề cho cho các sheet
Trả lời
4
Đọc
171
hieu998
H
GPE-Trợ Lý
[GPE] HỘI THẢO POWER QUERY – CÔNG CỤ QUẢN LÝ DỮ LIỆU HCM (2 người xem)
    • Thích
Trả lời
1
Đọc
946
GPE-Trợ Lý
GPE-Trợ Lý
Z
TRỢ GIÚP K SORT ĐƯỢC THỨ TỰ NGÀY THÁNG NĂM TRONG EXCEL
Trả lời
2
Đọc
117
Duy Tùng 9x
Duy Tùng 9x
H
Tách file nguồn thành nhiều file dựa vào điều kiện
Trả lời
5
Đọc
162
LePhatHuy
LePhatHuy
F
  • Question Question
Tự động Merge Mail bằng VBA
Trả lời
7
Đọc
358
fujishima
F
Nguyễn Duy Tuân
Phiên bản mới Add-in A-Tools v10 (2024)
    • Thích
2 3
Trả lời
49
Đọc
4K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
N
tính thể tích bồn dầu hình trụ elip nằm ngang
Trả lời
10
Đọc
47K
pvkiem
P
vsitcnh
Hỗ trợ công thức tính điểm dựa theo điều kiện.
Trả lời
18
Đọc
408
tle2003
T
GPE-Trợ Lý
Đăng ký tham dự hội thảo tại Hà Nội: Power Query - Công cụ quản lý dữ liệu
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
14
Đọc
2K
GPE-Trợ Lý
GPE-Trợ Lý
G
Xin Code xóa Module.
Trả lời
10
Đọc
495
GCQ
G
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
16 17 18
Trả lời
348
Đọc
31K
ongke0711
ongke0711
D
  • Đã giải quyết
Quản lý email outlook qua VBA cần giúp đỡ
2
Trả lời
23
Đọc
801
nguyendang95
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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
[GPE] HỘI THẢO POWER QUERY – CÔNG CỤ QUẢN LÝ DỮ LIỆU HCM
Back
Top Bottom