Xin giải pháp nhập dữ liệu vào ô trống hàng loạt

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài

Decepticon

Thành viên chính thức
Tham gia
25/4/16
Bài viết
53
Được thích
1
Chào các bác. File excel của e có rất nhiều ô trống cần nhập dữ liệu như file mẫu (các ô bôi vàng), hiện tại e sử dụng hàm vlookup (sheet B1) để ra được kết quả như sheet B2 cơ mà rất mất thời gian. Nhờ các bác xem giúp e có add-in, macro hay giải pháp nào để nhập hàng loạt, không cần tạo table tô màu cam + vlookup như e làm nữa không ạ. E cám ơn nhiều

File mẫu: https://hashru.link/__UxbBN9PMLFjDU5.xlsx


1718362947888.png
 
Chào các bác. File excel của e có rất nhiều ô trống cần nhập dữ liệu như file mẫu (các ô bôi vàng), hiện tại e sử dụng hàm vlookup (sheet B1) để ra được kết quả như sheet B2 cơ mà rất mất thời gian. Nhờ các bác xem giúp e có add-in, macro hay giải pháp nào để nhập hàng loạt, không cần tạo table tô màu cam + vlookup như e làm nữa không ạ. E cám ơn nhiều

File mẫu: https://hashru.link/__UxbBN9PMLFjDU5.xlsx


View attachment 301710
Cột K,L là tự điền à hay chạy theo nguyên tắc nào.Bạn nói rõ điền như thế nào nhé.Viết code cần thông tin rõ ràng.
 
Upvote 0
Cột K,L là tự điền à hay chạy theo nguyên tắc nào.Bạn nói rõ điền như thế nào nhé.Viết code cần thông tin rõ ràng.

Không cần quan tâm Cột K, L đâu ạ, e cần lấp vùng dữ liệu được chọn theo cột lọc trùng thôi.
Ví dụ: Cột lọc trùng là D:D, vùng chọn là H2:H18
D2 = 'Hồng' ; H2 = 'Giá thành'!B1
D6 = 'Hồng' ; H6 = '(trống)'
=> H6 update = 'Giá thành'!B1

D8 = 'Quýt' ; H8 = 'Giá thành'!B6
D15 = 'Quýt' ; H15= 'Giá thành'!B10
=> H15 update = 'Giá thành'!B6

do dòng 8 là dòng đầu tiên xuất hiện 'Quýt' COUNTIF($D$2:D8;D8) = 1 nên tất cả các dòng chứa 'Quýt' về sau phải lấy giá trị H8 (tương tự Vlookup)

1718434411984.png
 
Upvote 0
Không cần quan tâm Cột K, L đâu ạ, e cần lấp vùng dữ liệu được chọn theo cột lọc trùng thôi.
Ví dụ: Cột lọc trùng là D:D, vùng chọn là H2:H18
D2 = 'Hồng' ; H2 = 'Giá thành'!B1
D6 = 'Hồng' ; H6 = '(trống)'
=> H6 update = 'Giá thành'!B1

D8 = 'Quýt' ; H8 = 'Giá thành'!B6
D15 = 'Quýt' ; H15= 'Giá thành'!B10
=> H15 update = 'Giá thành'!B6

do dòng 8 là dòng đầu tiên xuất hiện 'Quýt' COUNTIF($D$2:D8;D8) = 1 nên tất cả các dòng chứa 'Quýt' về sau phải lấy giá trị H8 (tương tự Vlookup)

View attachment 301730
Thế còn lô hàng kia đánh thế nào.
 
Upvote 0
Đây là đoạn mã ví dụ cho việc tìm ô trống trong cột B, bạn thay bằng các cột tương ứng trong bảng của mình nhé!
Mã:
Sub FillBlankCells()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim searchValue As Variant
    Dim foundValue As Range
  
    ' Đặt trang tính cần làm việc
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Thay "Sheet1" bằng tên trang tính của bạn
  
    ' Vùng dữ liệu từ A1:B1000
    Set rng = ws.Range("A1:B1000")
  
' Duyệt qua từng ô trong cột B từ B1 đến B1000
For Each cell In ws.Range("B1:B1000")
    ' Kiểm tra ô có trống không
    If IsEmpty(cell.Value) Then
        ' Lấy giá trị từ cột A ở cùng hàng
        searchValue = cell.Offset(0, -1).Value
        
        ' Sử dụng hàm VLOOKUP để tìm giá trị trong cột B
        Dim vlookupResult As Variant
        vlookupResult = Application.VLookup(searchValue, ws.Range("A1:B1000"), 2, False)
        
        ' Kiểm tra kết quả của VLOOKUP
        If Not IsError(vlookupResult) Then
            ' Nếu tìm thấy giá trị thì điền vào ô trống
            cell.Value = vlookupResult
        Else
            ' Nếu không tìm thấy giá trị thì tô màu xanh dương cho ô đó
            cell.Interior.Color = RGB(0, 0, 255)
        End If
    End If
Next cell

End Sub
Đoạn mã này sẽ kiểm tra từng ô trong cột B. Nếu ô nào trống, nó sẽ tìm giá trị tương ứng trong cột A và điền vào ô trống đó. Nếu không tìm thấy giá trị tương ứng, ô đó sẽ được tô màu xanh dương.
Bài viết được lưu trữ tại đây.
 
Lần chỉnh sửa cuối:
Upvote 0
Đây là đoạn mã ví dụ cho việc tìm ô trống trong cột B, bạn thay bằng các cột tương ứng trong bảng của mình nhé!
Mã:
Sub FillBlankCells()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim searchValue As Variant
    Dim foundValue As Range
 
    ' Đặt trang tính cần làm việc
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Thay "Sheet1" bằng tên trang tính của bạn
 
    ' Vùng dữ liệu từ A1:B1000
    Set rng = ws.Range("A1:B1000")
 
' Duyệt qua từng ô trong cột B từ B1 đến B1000
For Each cell In ws.Range("B1:B1000")
    ' Kiểm tra ô có trống không
    If IsEmpty(cell.Value) Then
        ' Lấy giá trị từ cột A ở cùng hàng
        searchValue = cell.Offset(0, -1).Value
 
        ' Sử dụng hàm VLOOKUP để tìm giá trị trong cột B
        Dim vlookupResult As Variant
        vlookupResult = Application.VLookup(searchValue, ws.Range("A1:B1000"), 2, False)
 
        ' Kiểm tra kết quả của VLOOKUP
        If Not IsError(vlookupResult) Then
            ' Nếu tìm thấy giá trị thì điền vào ô trống
            cell.Value = vlookupResult
        Else
            ' Nếu không tìm thấy giá trị thì tô màu xanh dương cho ô đó
            cell.Interior.Color = RGB(0, 0, 255)
        End If
    End If
Next cell

End Sub
Đoạn mã này sẽ kiểm tra từng ô trong cột B. Nếu ô nào trống, nó sẽ tìm giá trị tương ứng trong cột A và điền vào ô trống đó. Nếu không tìm thấy giá trị tương ứng, ô đó sẽ được tô màu xanh dương.
Bài viết được lưu trữ tại đây.

Thanks b. Tuy ko hiểu lắm nhưng có vẻ không phải cái e cần. E muốn update tất cả ô trong vùng chọn mà bên Cột lọc trùng xuất hiện lần 2 trở đi COUNTIF(...) >=2

E giải thích lai quy trình e làm thủ công cho các bác dễ hiểu:
B1: Tạo cột Lọc trùng bằng hàm =CONCATENATE(...)
B2: Tạo cột đếm lần xuất hiện bằng hàm =COUNTIF(...)
B3: Filter các dòng có COUNIF(...) = 1, copy ra 1 Table riêng (*), trước tiên phải chuyển vùng chọn thành text bằng cách thêm " vào trước dấu = (replace all = thành "= ) mới copy đc
B4: Filter các dòng có COUNIF(...) > 1, dùng hàn VLOOKUP để lấy giá trị formula từ Table riêng (*)
B5: Chuyển vùng chọn thành text
B6: replace all "= thành = . Xong
 

File đính kèm

  • 5qb010.xlsx
    40.9 KB · Đọc: 9
Lần chỉnh sửa cuối:
Upvote 0
Thanks b. Tuy ko hiểu lắm nhưng có vẻ không phải cái e cần. E muốn update tất cả ô trong vùng chọn mà bên Cột lọc trùng xuất hiện lần 2 trở đi COUNTIF(...) >=2

E giải thích lai quy trình e làm thủ công cho các bác dễ hiểu:
B1: Tạo cột Lọc trùng bằng hàm =CONCATENATE(...)
B2: Tạo cột đếm lần xuất hiện bằng hàm =COUNTIF(...)
B3: Filter các dòng có COUNIF(...) = 1, copy ra 1 Table riêng (*), trước tiên phải chuyển vùng chọn thành text bằng cách thêm " vào trước dấu = (replace all = thành "= ) mới copy đc
B4: Filter các dòng có COUNIF(...) > 1, dùng hàn VLOOKUP để lấy giá trị formula từ Table riêng (*)
B5: Chuyển vùng chọn thành text
B6: replace all "= thành = . Xong
Code trên mình dùng đây, chắc không phải cái bạn cần!
SYXXc.gif

Bài đã được tự động gộp:

hoặc có thể dùng Vlookup ngay từ B1 mà nhỉ!

SYXX1.gif
 
Lần chỉnh sửa cuối:
Upvote 0
e chạy thử chỉ thấy ô trống bị bôi xanh thôi, bác ktra giúp e sai ở chỗ nào ạ?

Mã:
Sub FillBlankCells()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim searchValue As Variant
    Dim foundValue As Range
 
    ' Ð?t trang tính c?n làm vi?c
    Set ws = ThisWorkbook.Sheets("0---") ' Thay "Sheet1" b?ng tên trang tính c?a b?n
 
    ' Vùng d? li?u t? A1:B1000
    Set rng = ws.Range("b1:j18")
 
' Duy?t qua t?ng ô trong c?t B t? B1 d?n B1000
For Each cell In ws.Range("f1:f18")
    ' Ki?m tra ô có tr?ng không
    If IsEmpty(cell.Value) Then
        ' L?y giá tr? t? c?t A ? cùng hàng
        searchValue = cell.Offset(0, -1).Value
      
        ' S? d?ng hàm VLOOKUP d? tìm giá tr? trong c?t B
        Dim vlookupResult As Variant
        vlookupResult = Application.VLookup(searchValue, ws.Range("b1:j18"), 4, False)
      
        ' Ki?m tra k?t qu? c?a VLOOKUP
        If Not IsError(vlookupResult) Then
            ' N?u tìm th?y giá tr? thì di?n vào ô tr?ng
            cell.Value = vlookupResult
        Else
            ' N?u không tìm th?y giá tr? thì tô màu xanh duong cho ô dó
            cell.Interior.Color = RGB(0, 0, 255)
        End If
    End If
Next cell

End Sub

Vlookup B1 thì bài toán lại đơn giản quá :))
 
Lần chỉnh sửa cuối:
Upvote 0
Lần chỉnh sửa cuối:
Upvote 0
Upvote 0
Chào các bác. File excel của e có rất nhiều ô trống cần nhập dữ liệu như file mẫu (các ô bôi vàng), hiện tại e sử dụng hàm vlookup (sheet B1) để ra được kết quả như sheet B2 cơ mà rất mất thời gian. Nhờ các bác xem giúp e có add-in, macro hay giải pháp nào để nhập hàng loạt, không cần tạo table tô màu cam + vlookup như e làm nữa không ạ. E cám ơn nhiều
.
Thử code này xem có kết quả có đúng không? Hên xui.
Mã:
Public Sub Test()
'Dien gia vao cell trong
Dim i&, k&, u&, lr&, v&, temp$
Dim sArr, vArr
Dim Dic

Set Dic = CreateObject("Scripting.Dictionary")
lr = Range("D2").End(xlDown).Row
sArr = Range("D2:J" & lr).Value
u = UBound(sArr)
ReDim vArr(1 To u, 1 To 4)
For i = 1 To u
    temp = sArr(i, 1) & sArr(i, 2)
    If Not Dic.exists(temp) Then
        k = k + 1
        Dic.Add temp, k
        vArr(k, 1) = temp
        vArr(k, 2) = sArr(i, 3)
        vArr(k, 3) = sArr(i, 5)
        vArr(k, 4) = sArr(i, 7)
    Else
        v = Dic.Item(temp)
        If sArr(i, 3) <> "" Then
            vArr(v, 2) = sArr(i, 3)
        Else
            sArr(i, 3) = vArr(v, 2)
            sArr(i, 5) = vArr(v, 3)
            sArr(i, 7) = vArr(v, 4)
        End If
    End If
    
Next i
Range("D2").Resize(u, 7).Value = sArr
End Sub
 
Upvote 0
À bạn muốn link trực tiếp để sau này có thể dùng Ctrl + [ để kiểm tra à!
Đúng rồi bác. Nó mất thời gian ở chỗ đó á

.
Thử code này xem có kết quả có đúng không? Hên xui.
Mã:
Public Sub Test()
'Dien gia vao cell trong
Dim i&, k&, u&, lr&, v&, temp$
Dim sArr, vArr
Dim Dic

Set Dic = CreateObject("Scripting.Dictionary")
lr = Range("D2").End(xlDown).Row
sArr = Range("D2:J" & lr).Value
u = UBound(sArr)
ReDim vArr(1 To u, 1 To 4)
For i = 1 To u
    temp = sArr(i, 1) & sArr(i, 2)
    If Not Dic.exists(temp) Then
        k = k + 1
        Dic.Add temp, k
        vArr(k, 1) = temp
        vArr(k, 2) = sArr(i, 3)
        vArr(k, 3) = sArr(i, 5)
        vArr(k, 4) = sArr(i, 7)
    Else
        v = Dic.Item(temp)
        If sArr(i, 3) <> "" Then
            vArr(v, 2) = sArr(i, 3)
        Else
            sArr(i, 3) = vArr(v, 2)
            sArr(i, 5) = vArr(v, 3)
            sArr(i, 7) = vArr(v, 4)
        End If
    End If
 
Next i
Range("D2").Resize(u, 7).Value = sArr
End Sub

Thanks bác. Code cho kết quả là số chết nên ko ăn thua bác ah ^^!
Bài đã được tự động gộp:

Nếu chịu khó đừng viết tắt và tiếng Tây bồi thì đã không phải đợi đến giờ này mới thấy tăm hơi bài giải.

Có vẻ e giải thích ko rõ ràng mà #1 ko cho edit nữa nên e bổ sung các bước làm thủ công ở #7 cho mọi người dễ hình dung

 
Lần chỉnh sửa cuối:
Upvote 0
Nếu chịu khó đừng viết tắt và tiếng Tây bồi thì đã không phải đợi đến giờ này mới thấy tăm hơi bài giải.
Có vẻ e giải thích ko rõ ràng mà #1 ko cho edit nữa nên e bổ sung các bước làm thủ công ở #7 cho mọi người dễ hình dung
Có lẽ đây sẽ là đoạn hội thoại cọc cạch nhất trong ngày. (Mà có khi do không hiểu cũng nên).
 
Upvote 0
Đúng rồi bác. Nó mất thời gian ở chỗ đó á



Thanks bác. Code cho kết quả là số chết nên ko ăn thua bác ah ^^!
Bài đã được tự động gộp:



Có vẻ e giải thích ko rõ ràng mà #1 ko cho edit nữa nên e bổ sung các bước làm thủ công ở #7 cho mọi người dễ hình dung

Ịn em này vào file rồi test thử.
Yêu cầu: Các dòng trống cần nạp công thức của cột F, H, J là cùng chỉ số
Mã:
Option Explicit

Sub xxx()
Dim Ten
Dim Tam
Dim i, j, k
Dim dicTK As Object
Set dicTK = CreateObject("Scripting.Dictionary")
With Sheet1
    For i = 2 To 18
        Ten = .Range("D" & i) & "|" & .Range("E" & i)
        If .Range("F" & i) <> "" Then
            If dicTK.exists(Ten) = False Then dicTK(Ten) = i
        Else
            k = dicTK(Ten)
            
            Tam = .Range("F" & k).Formula
            .Range("F" & i).Formula = Tam
            
            Tam = .Range("H" & k).Formula
            .Range("H" & i).Formula = Tam
            
            Tam = .Range("J" & k).Formula
            .Range("J" & i).Formula = Tam
        End If
    Next i
End With

End Sub
 
Upvote 0
Ịn em này vào file rồi test thử.
Yêu cầu: Các dòng trống cần nạp công thức của cột F, H, J là cùng chỉ số
Mã:
Option Explicit

Sub xxx()
Dim Ten
Dim Tam
Dim i, j, k
Dim dicTK As Object
Set dicTK = CreateObject("Scripting.Dictionary")
With Sheet1
    For i = 2 To 18
        Ten = .Range("D" & i) & "|" & .Range("E" & i)
        If .Range("F" & i) <> "" Then
            If dicTK.exists(Ten) = False Then dicTK(Ten) = i
        Else
            k = dicTK(Ten)
         
            Tam = .Range("F" & k).Formula
            .Range("F" & i).Formula = Tam
         
            Tam = .Range("H" & k).Formula
            .Range("H" & i).Formula = Tam
         
            Tam = .Range("J" & k).Formula
            .Range("J" & i).Formula = Tam
        End If
    Next i
End With

End Sub

Cập nhật: Ko ổn rồi bác ạ. Tuy code hoạt động đúng như e cần nhưng lại chậm quá. E chạy thử 1 sheet 5k dòng mà mãi không xong T_T

Chắc e quay về phương án thủ công ban đầu thui, macro vba có vẻ không phù hợp để xử lý dữ liệu lớn :(
 
Lần chỉnh sửa cuối:
Upvote 0
Ịn em này vào file rồi test thử.
Yêu cầu: Các dòng trống cần nạp công thức của cột F, H, J là cùng chỉ số
...
Cơm nấu thơm phức rồi mà còn phải chờ người ta đem chén kiểu đũa ngà mới bới.
Thấy nồi cơm chịu củi lửa mà nghĩ thương cái chỗ chùi nhọ.
 
Upvote 0
Web KT
Back
Top Bottom