Giúp dùm mình viết code thay thế hàm vlookup và code update (1 người xem)

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

phucuongn

Thành viên mới
Tham gia
25/7/09
Bài viết
15
Được thích
5
Chào các anh chị trên diễn đàn ! mình có một vấn đề nhờ các anh chị giúp mình
Mình có một file gồm 3 sheet (data, chitiet,tonghop)
mình muốn khi nhập dữ liệu ở sheet chitiet thì sheet này dò tìm ở sheet data để lấy dữ liệu qua
sau đó mình nhấn nút send thì các dữ liệu ở sheet chitiet sẽ gửi qua sheet tonghop để lưu lại hàng ngày
đồng thời xóa dữ liệu ở sheet chitiet
Nhờ các anh chị giúp mình viết code thay thế hàm vlookup và code update khi nhấn nút send
cám ơn các anh chị rất nhiều
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
1/ Hàm VLOOKUP trong VBA :
....
With Sheets("ChiTiet")
.Range("B7")=WorksheetFunction.Vlookup(.Range("A7"),Sheets("data").Range("A2:R500"),4,0)
.....
End With

2/ Cập nhật
....
n = Sheets("TongHop").Range("A65000").End(xlUp).Row
For i = 1 To 16
Sheets("TongHop").Cells(n+1,i)=Sheets("ChiTiet").Cells(7,i)
Next
 
Upvote 0
Cụ thể hơn nữa cho bạn đây

Vì cột 'A' trong trang 'Chi tiet' có dữ liệu đến dòng 26; Vậy cho nên quy trình vận hành có đổi chuyển xíu, như sau:

Để xóa các records đã nhập & chuyển sang 'Tong hop', ta cần chọn [C3] & {ENTER} là xuất hiện hộp thoại & ta OK là xong.
 

File đính kèm

Upvote 0
Chào Bạn ! Cám ơn bạn rất nhiều. Nhưng còn phần send và xóa nhờ bạn sửa lại giúp mình một chút nha
Phần vlookup bạn đã làm theo đúng theo ý của mình rồi .
Phần cập nhật bạn sửa lại giúp mình một chút
File của bạn khi bấm nút send nó chỉ có copy qua có cột ngày thôi các cột khác nó không qua sheet "tonghop"
còn khi xóa thì hơi bị rắc rối. Nếu lỡ tay chọn ngay ô [C3] & {ENTER} thì dữ liệu bị xóa hết chưa có kịp send.
Nhờ bạn sửa lại giúp là
Khi nhấn nút SEND thì xuất hiện hộp hội thoại xác nhận "Yes" hay "No" nếu Yes thì copy dữ liệu từ sheet chitiet qua sheet tonghop
đồng thời sẽ xóa luôn dữ liệu ở sheet chitiet . bạn viết thêm giúp ở [C3] mình muốn hiện ngày hệ thống nhưng có thể sửa lại được
cám ơn bạn rất nhiều .
 
Upvote 0
Theo mình thì không cần xóa sau khi chép đâu

Mà bạn nhập ngày mới vô C3 thì dữ liệu ngày cũ sẽ bị xóa; Còn không thì để xem, cũng sẽ tiên việc biết rằng dữ liệu đó đã được nhập rồi.

Còn đây là thêm 3 dòng lệnh hỏi bạn việc chép dòng mà bạn đã chọn hay không:

PHP: 
Option Explicit
Sub TongHop()
 Dim Sh As Worksheet, Rws As Long, MyColor As Byte
 
 Set Sh = Sheets("Tong hop"):       Rws = Selection.Row
0 MyColor = MsgBox("Ban Càn Chép Dòng " & Rws, vbYesNo + vbQuestion, "GPE")
1 If MyColor = 6 Then
   MyColor = [b3].Interior.ColorIndex + 1
   With Sh.[C65500].End(xlUp).Offset(1)
      .Offset(, -1).Value = [c3].Value
      .Resize(, 4).Value = Cells(Rws, "B").Resize(, 16).Value
   End With
   If MyColor > 42 Then MyColor = 34
   [b3].Interior.ColorIndex = MyColor
9 End If
End Sub
Nếu chưa muốn chéo thì báo cho nó biết, bằng cách nhấn vô 'No', để nó không chép.

Bạn thêm 3 dòng lệnh có đánh số, hay copy & chép đè lên toàn bộ macro cũ

Thân ái & chúc tuần làm việc thành công!
 
Upvote 0
Cám ơn bạn có ý rất hay nhưng do tính chất công việc của mình là
MỘt ngày mình phải in cho từng nhân viên giao hàng trên sheet chitiet
Trên sheet "chitiet" dùng để in cho từng nhân viên giao hàng. MỘt người giao hàng có thể giao nhiều khách hàng
(mình cho từ dòng 7 đến dòng 26) .Sau khi in cho nhân viên A xong thì đến nhân viên B
Do đó dữ liệu của nhân viên A phải copy tòan bộ qua sheet "tonghop" lưu lại và xóa bên sheet chitiet đi để nhập dữ liệu và in cho nhân viên B
Cứ như vậy 1 ngày mình nhập dữ liệu và in cho nhiều nhân viên trên sheet chitiet.
file của bạn chỉ copy được có 1 dòng mà mình chọn .Ý mình muốn copy tòan bộ từ dòng 7 đến dòng 26.
Nhờ bạn sửa lại giúp mỗi lần send thì copy tòan bộ từ dòng 7 đến dòng 26 qua sheet tonghop
Cám ơn bạn rất nhiều
 
Upvote 0
Cảm thấy có lỗi do để bạn chờ lâu!

Bạn dùng con macro này thay cho macro cùng chức năng bên trên:

PHP: 
Option Explicit
Sub TongHop()
 Dim Sh As Worksheet, Rws As Long, MyColor As Byte
 Dim Cls As Range, Rng As Range
 
 Set Sh = Sheets("Tong hop")
 Rws = Range([B7], [B7].End(xlDown)).Rows.Count
 MyColor = _
   MsgBox("Ban Càn Chép Sang 'TongHop' " & Rws & " Dòng?", vbYesNo + vbQuestion, "GPE")
 If MyColor = 6 Then
   MyColor = [b3].Interior.ColorIndex + 1
   Set Rng = Sh.[C65500].End(xlUp).Offset(1)
   With Rng
      .Offset(, -1).Resize(Rws).Value = [c3].Value
      .Resize(Rws, 16).Value = Cells(7, "B").Resize(Rws, 16).Value
   End With
5 ' Null Amount If Inv Type<> "Z000"'
   For Each Cls In Rng.Offset(, 5).Resize(Rws)
      If Cls.Value <> "Z000" Then Cls.Offset(, 1).Value = ""
6   Next Cls
   If MyColor > 42 Then MyColor = 34
   [b3].Interior.ColorIndex = MyColor
   [B7].Resize(Rws, 16).Value = ""
 End If
End Sub
Chú í thêm:
Giữa các dòng được đánh số là các lệnh để biến cột [Thành tiền] => Null một khi cột bên trái liền kề không chứa 'Z000'
Nếu không cần thì bạn bỏ hay vô hiệu hóa giúp các dòng đó đi nha.
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Cám ơn bạn rất nhiều ,bạn đã làm theo đúng ý của mình rồi nhưng khi chạy thử có sai 1 chút nhờ bạn sửa lại giúp nha.
1. Khi dữ liệu ở sheet chitiet có 1 dòng thì thì send nó báo copy đến 65550 dòng lận đó.
2. Nếu bên sheet tonghop chưa có dòng dữ liệu nào thì khi send từ sheet chitiet (có nhiều dòng) thì nó chỉ copy qua có 1 dòng đầu
Khi nào bên sheet tonghop có dữ liệu rồi thì copy mới đúng.
3. Nhờ bạn sửa lại giúp 1 chút nữa nha, mình muốn bỏ cột M "nhân viên giao hàng" cho nó lên [C4] giống như ngày vậy đó vì 1 lần in chỉ có 1 người thôi.
Cám ơn bạn rất nhiều ! xong vụ này mình mời bạn 1 chầu cafe
 
Upvote 0
He,he, sắp được uống càfê rồi, bà con ơi.

Bạn dùng đoạn mã này với các chú í sau:

(1) Bạn chưa nói với tôi là bạn sẽ bỏ hay không bỏ cột 'M' của 'Chi Tiet' đó nha.

(2) Bạn có vẻ coi thường tiếng mẹ đẻ đó nha, thì đây:
(Tại trang tính 'Tong Hop') cớ sao [B6:C6] không có tiếng Việt, mà các ô khác sau nó trong hàng có đủ vậy?
Bạn fải có chính sách nhất quán trong CSDL mới được. (Thật ra trong bản thử của mình đã chỉnh lại nhưng quên truyền thông đến bạn đó thôi. Giờ bạn chỉnh lại trước khi cho macro chạy, nha.)
PHP: 
Option Explicit
Sub TongHop()
 Dim Sh As Worksheet, Rws As Long, MyColor As Byte
 Dim Cls As Range, Rng As Range
 
 Set Sh = Sheets("Tong hop")
 Rws = Range([B7], [B7].End(xlDown)).Rows.Count
1 If Rws > 99 Then Rws = 1
 MyColor = _
   MsgBox("Ban Càn Chép Sang 'TongHop' " & Rws & " Dòng?", vbYesNo + vbQuestion, "GPE")
 If MyColor = 6 Then
   MyColor = [b3].Interior.ColorIndex + 1
   Set Rng = Sh.[C65500].End(xlUp).Offset(1)
   With Rng
      .Offset(, -1).Resize(Rws).Value = [c3].Value
      .Resize(Rws, 16).Value = Cells(7, "B").Resize(Rws, 16).Value
3      .Offset(, 11).Resize(Rws).Value = [c4].Value
   End With
5 ' Null Amount If Inv Type<> "Z000"'
   For Each Cls In Rng.Offset(, 5).Resize(Rws)
      If Cls.Value <> "Z000" Then Cls.Offset(, 1).Value = ""
   Next Cls
   If MyColor > 42 Then MyColor = 34
   [b3].Interior.ColorIndex = MyColor
   [B7].Resize(Rws, 16).Value = ""
 End If
End Sub
 
Upvote 0
Cám ơn bạn rất nhiều, Bạn chuẩn bị sắp xếp thời gian để uống cafe được rồi đó.
Mình mới test thử thấy ok rồi , nhưng thời gian sử dụng lâu dài có trục trặc biết tìm bản ở đâu ?
Thôi hứa thì phải giữ lời ,mình mời bạn uống cafe nha, địa điểm do bạn chọn Đồng Nai, Bình Dương, TP HCM khu vực khác thì mình bó tay
Cám ơn tất cả các bạn nha !
DC mail : cuongnp75@yahoo.com.vn
 
Upvote 0
Giúp mình code cho hàm VLOOKUP này vơí.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
namkpac đã viết:
Giúp mình code cho hàm VLOOKUP này vơí.
Nhấp chuột vào đây để mở rộng...
Bạn Record Macro là ra code ngay thôi mà.
Sau khi Record Macro và chỉnh lại một chút (giữ nguyên công thức của bạn) thì được code như sau:
[GPECODE=vb]Sub Macro1()
Sheet1.Range("J6:J" & Sheet1.[I65000].End(xlUp).Row).FormulaR1C1 = "=IF(RC[-1]=0,"""",VLOOKUP(RC[-1],MLNS,3,0))"
End Sub[/GPECODE]
 
Upvote 0
nghiaphuc đã viết:
Bạn Record Macro là ra code ngay thôi mà.
Sau khi Record Macro và chỉnh lại một chút (giữ nguyên công thức của bạn) thì được code như sau:
[GPECODE=vb]Sub Macro1()
Sheet1.Range("J6:J" & Sheet1.[I65000].End(xlUp).Row).FormulaR1C1 = "=IF(RC[-1]=0,"""",VLOOKUP(RC[-1],MLNS,3,0))"
End Sub[/GPECODE]
Nhấp chuột vào đây để mở rộng...
chào anh, em muốn chuyển hàm thành code vba chứ làm theo macro em làm được rồi anh, ví dụ file em gửi có phần change em muốn sau khi nhập số vào thì tự nhảy. trong file có hàm if lồng với hàm vlook up
 
Upvote 0
namkpac đã viết:
chào anh, em muốn chuyển hàm thành code vba chứ làm theo macro em làm được rồi anh, ví dụ file em gửi có phần change em muốn sau khi nhập số vào thì tự nhảy. trong file có hàm if lồng với hàm vlook up
Nhấp chuột vào đây để mở rộng...
Tôi dùng code này cho Sheet1 (tạm thời khóa Sub Worksheet_Change của bạn lại để kiểm tra nhé):
[GPECODE=vb]Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cll As Range, Rng As Range
If Target.Column <> 9 Then Exit Sub
For Each Cll In Intersect(Target, [I:I])
If Cll <> "" Then
Set Rng = Sheet2.[A:A].Find(Cll, LookAt:=xlWhole)
If Rng Is Nothing Then
Cll.Offset(, 1).ClearContents
Else
Cll.Offset(, 1) = Rng.Offset(, 2)
End If
End If
Next
End Sub[/GPECODE]
Xin hỏi lại bạn một chút: Trên cột A của Sheet2 có nhiều giá trị trùng nhau, vậy thì bạn muốn xử lý tình huống này như thế nào? Trong code trên, tôi xử lý theo hướng lấy giá trị đầu tiên tìm được.
 
Upvote 0
em cảm ơn anh, cái MLNS là em đặt tên define name mục đích là nếu cột i bắt đầu từ i6 = 0 thì để ký tự rỗng, còn >0 thì dò trong MLNS trong đó có 3 cột thì tương ứng với cell cột i sheet 1 thì lấy giá trị MLNS điền vào các giá trị cột A, B sheet 2 không ảnh hưởng đến việc lấy giá trị của cột C
 
Upvote 0
namkpac đã viết:
em cảm ơn anh, cái MLNS là em đặt tên define name mục đích là nếu cột i bắt đầu từ i6 = 0 thì để ký tự rỗng, còn >0 thì dò trong MLNS trong đó có 3 cột thì tương ứng với cell cột i sheet 1 thì lấy giá trị MLNS điền vào các giá trị cột A, B sheet 2 không ảnh hưởng đến việc lấy giá trị của cột C
Nhấp chuột vào đây để mở rộng...
Nãy giờ tôi "nghiền ngẫm" từng từ trong bài của bạn mà thiệt tình là tôi chẳng hiểu bạn đang viết cái gì cả (hình như tôi dốt văn quá mất rồi!
Tôi muốn bạn xác nhận lại: Trường hợp cột A của Sheet2 có nhiều giá trị trùng nhau thì bạn xử lý ra sao? Chẳng hạn: Tại ô I6 của Sheet1, tôi nhập số 5 thì ô J6 phải lấy giá trị nào trong 2 số: 99 và 8?
Thêm nữa, cột B trên Sheet2 có đóng vai trò gì trong bài toán tìm kiếm này không?
 
Upvote 0
nghiaphuc đã viết:
Nãy giờ tôi "nghiền ngẫm" từng từ trong bài của bạn mà thiệt tình là tôi chẳng hiểu bạn đang viết cái gì cả (hình như tôi dốt văn quá mất rồi!
Tôi muốn bạn xác nhận lại: Trường hợp cột A của Sheet2 có nhiều giá trị trùng nhau thì bạn xử lý ra sao? Chẳng hạn: Tại ô I6 của Sheet1, tôi nhập số 5 thì ô J6 phải lấy giá trị nào trong 2 số: 99 và 8?
Thêm nữa, cột B trên Sheet2 có đóng vai trò gì trong bài toán tìm kiếm này không?
Nhấp chuột vào đây để mở rộng...

em cảm ơn anh, bài này của em là khi nhập giá trị vào cột i sheet thì giá trị cột A sheet2 là tương ứng. còn giá trị thì chỉ lấy 1 lần chẳng hạn đã lấy 99 thì chỉ lấy 99 ko lấy 8 nữa. em thử code của anh rồi nó chạy như mong muốn của em. em cảm ơn anh nhiều. anh cho em biết ym của anh với có gì cho em được hỏi và học code từ anh với.
 
Upvote 0
namkpac đã viết:
em cảm ơn anh, bài này của em là khi nhập giá trị vào cột i sheet thì giá trị cột A sheet2 là tương ứng. còn giá trị thì chỉ lấy 1 lần chẳng hạn đã lấy 99 thì chỉ lấy 99 ko lấy 8 nữa. em thử code của anh rồi nó chạy như mong muốn của em. em cảm ơn anh nhiều. anh cho em biết ym của anh với có gì cho em được hỏi và học code từ anh với.
Nhấp chuột vào đây để mở rộng...
Code chạy đúng như mong muốn của bạn là tốt rồi.

Tôi không có dùng Y!M và nói chung là các phần mềm chat. Có vấn đề gì, chúng ta cùng trao đổi trên GPE luôn. Thực ra thì tôi cũng đang học, và tôi cũng muốn được học nhiều hơn từ các thành viên khác, chắc gì cách giải quyết của tôi đã hay?! Có thể các thành viên khác có nhiều cách giải quyết hay hơn. Vì vậy, nếu chúng ta trao đổi các vấn đề ở trên này thì cả tôi, bạn và nhiều thành viên khác cùng được học hỏi lẫn nhau. Vậy nhé!

Thân mến!
 
Upvote 0
nghiaphuc đã viết:
Code chạy đúng như mong muốn của bạn là tốt rồi.

Tôi không có dùng Y!M và nói chung là các phần mềm chat. Có vấn đề gì, chúng ta cùng trao đổi trên GPE luôn. Thực ra thì tôi cũng đang học, và tôi cũng muốn được học nhiều hơn từ các thành viên khác, chắc gì cách giải quyết của tôi đã hay?! Có thể các thành viên khác có nhiều cách giải quyết hay hơn. Vì vậy, nếu chúng ta trao đổi các vấn đề ở trên này thì cả tôi, bạn và nhiều thành viên khác cùng được học hỏi lẫn nhau. Vậy nhé!

Thân mến!
Nhấp chuột vào đây để mở rộng...

Em có một câu hỏi này muốn hỏi anh và mọi người trên diễn đàn giúp em, cũng file ở trên, giờ em muốn change vào sheet như trên với nội dung là các đoạn code đó nằm trong 1 thủ tục ko tách ra vì em thử đưa nhiều hàm if vào trong code mà cứ mỗi lần làm cho 1 cột thì lại khai báo lại, các điều kiện thì khác nhau, các biến và mảng khác nhau.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Anh giúp em gom code lại thành 1 được ko ạ? em thử gom lại nhưng vẫn chưa được.
 
Upvote 0
namkpac đã viết:
Em có một câu hỏi này muốn hỏi anh và mọi người trên diễn đàn giúp em, cũng file ở trên, giờ em muốn change vào sheet như trên với nội dung là các đoạn code đó nằm trong 1 thủ tục ko tách ra vì em thử đưa nhiều hàm if vào trong code mà cứ mỗi lần làm cho 1 cột thì lại khai báo lại, các điều kiện thì khác nhau, các biến và mảng khác nhau.
Nhấp chuột vào đây để mở rộng...
Bạn gỡ bớt 1 file đi chứ để chi cả 2 file dữ vậy?
Sau khi gom lại thành "1 cục" thì code còn lại thế này:
[GPECODE=vb]Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cll As Range, Rng As Range
If Target.Column <> 6 And Target.Column <> 9 Then Exit Sub
For Each Cll In Intersect(Target, [F:F,I:I])
If Cll = "" Then
Cll.Offset(, IIf(Cll.Column = 6, -2, 1)).ClearContents
Else
If Cll.Column = 6 Then
Cll.Offset(, -2) = Cll.Offset(, 1) & Cll.Offset(, 2)
Else
Set Rng = Sheet2.[A:A].Find(Cll, LookAt:=xlWhole)
If Rng Is Nothing Then
Cll.Offset(, 1).ClearContents
Else
Cll.Offset(, 1) = Rng.Offset(, 2)
End If
End If
End If
Next
End Sub[/GPECODE]
À, khi bạn muốn khóa Sub Worksheet_Change của bạn lại thì chỉ đơn giản là bạn đổi tên nó thành Worksheet_Change1 (hoặc đại loại là thay đổi tên một chút xíu) thôi chứ không cần thêm dấu nháy đơn trước tất cả các dòng lệnh của nó đâu.
 
Upvote 0
nghiaphuc đã viết:
Bạn gỡ bớt 1 file đi chứ để chi cả 2 file dữ vậy?
Sau khi gom lại thành "1 cục" thì code còn lại thế này:
[GPECODE=vb]Private Sub Worksheet_Change(ByVal Target As Range)
End Sub[/GPECODE]
À, khi bạn muốn khóa Sub Worksheet_Change của bạn lại thì chỉ đơn giản là bạn đổi tên nó thành Worksheet_Change1 (hoặc đại loại là thay đổi tên một chút xíu) thôi chứ không cần thêm dấu nháy đơn trước tất cả các dòng lệnh của nó đâu.
Nhấp chuột vào đây để mở rộng...

Dạ em cảm ơn anh chỉ dạy. Hay thật em ko hiểu nổi vba lại hay như vậy. Anh chỉ cho em với được ko? còn nếu như có những cột khác mà cũng có hàm if nhưng nằm trong 1 sheet này thì sao ạ? vì trong file em gửi có 2 cột A và B trong đó có 2 công thức if nhưng em ko biết lồng nó vào như thế nào anh chỉ giúp em được ko? anh giúp em phân tích nghĩa của từng dòng lệnh với? còn gỡ bớt file em gỡ đuợc rồi.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
namkpac đã viết:
Dạ em cảm ơn anh chỉ dạy. Hay thật em ko hiểu nổi vba lại hay như vậy. Anh chỉ cho em với được ko? còn nếu như có những cột khác mà cũng có hàm if nhưng nằm trong 1 sheet này thì sao ạ? vì trong file em gửi có 2 cột A và B trong đó có 2 công thức if nhưng em ko biết lồng nó vào như thế nào anh chỉ giúp em được ko? anh giúp em phân tích nghĩa của từng dòng lệnh với? còn gỡ bớt file em gỡ đuợc rồi.
Nhấp chuột vào đây để mở rộng...

Giúp em gom công thức nằm trong 4 cột vào 1 sub worksheets change với
 
Upvote 0
nghiaphuc đã viết:
Bạn gỡ bớt 1 file đi chứ để chi cả 2 file dữ vậy?
À, khi bạn muốn khóa Sub Worksheet_Change của bạn lại thì chỉ đơn giản là bạn đổi tên nó thành Worksheet_Change1 (hoặc đại loại là thay đổi tên một chút xíu) thôi chứ không cần thêm dấu nháy đơn trước tất cả các dòng lệnh của nó đâu.
Nhấp chuột vào đây để mở rộng...

Anh nghiaphuc và mọi người giúp mình câu hỏi trên với, thanks mọi người
 
Upvote 0
Code thay cho hàm Vlookup ?

Xin chào các bạn,

Các bạn giúp đỡ Oanh Thơ code thay cho hàm Vlookup theo file đính kèm này với ạ.
 

File đính kèm

Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào các bạn,

Các bạn giúp đỡ Oanh Thơ code thay cho hàm Vlookup theo file đính kèm này với ạ.
Nhấp chuột vào đây để mở rộng...

Code này thay "Y chang" hàm Vlookup trong file của bạn nè, nếu muốn tổng quát hơn thì bạn tự chỉnh.
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, R As Long
sArr = Sheets("Data").Range("C4:I18").Value
dArr = Sheets("Sheet1").Range("C5:C8").Resize(, 6).Value
For I = 1 To 4
    R = dArr(I, 1) + 1
    For J = 2 To 6
        dArr(I, J) = sArr(R, J)
    Next J
Next I
Sheets("Sheet1").Range("C5:C8").Resize(, 6) = dArr
End Sub
 
Upvote 0
Ba Tê đã viết:
Code này thay "Y chang" hàm Vlookup trong file của bạn nè, nếu muốn tổng quát hơn thì bạn tự chỉnh.
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, R As Long
sArr = Sheets("Data").Range("C4:I18").Value
dArr = Sheets("Sheet1").Range("C5:C8").Resize(, 6).Value
For I = 1 To 4
    R = dArr(I, 1) + 1
    For J = 2 To 6
        dArr(I, J) = sArr(R, J)
    Next J
Next I
Sheets("Sheet1").Range("C5:C8").Resize(, 6) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...

Cảm ơn bạn Ba Tê đã giúp đỡ.
Dữ liệu thực của Oanh Thơ rất nhiều dòng và số dòng trong "sheet1" luôn biến động không cố định bao nhiêu dòng.
Bạn có thể code giúp Oanh Thơ bằng phương pháp sử dụng Dictionary được không ?
 
Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
Cảm ơn bạn Ba Tê đã giúp đỡ.
Dữ liệu thực của Oanh Thơ rất nhiều dòng và số dòng trong "sheet1" luôn biến động không cố định bao nhiêu dòng.
Bạn có thể code giúp Oanh Thơ bằng phương pháp sử dụng Dictionary được không ?
Nhấp chuột vào đây để mở rộng...
vì sao lại phải dùng Dictionary mới được vậy bạn. dữ liệu lớn thì Dic chưa chắc đã nhanh hơn mảng đâu, lý do muốn dùng Dictionary là gì (ngoài lọc duy nhất). đng tìm tòi tìm hiểu các thuật toán về vụ tìm kiếm, lọc thế này, được thì cứ đưa dữ liệu tràn lan đại hải lên. làm phát cho nhanh gọn đỡ phải lòi thêm phát sinh sau đó
 
Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
Cảm ơn bạn Ba Tê đã giúp đỡ.
Dữ liệu thực của Oanh Thơ rất nhiều dòng và số dòng trong "sheet1" luôn biến động không cố định bao nhiêu dòng.
Bạn có thể code giúp Oanh Thơ bằng phương pháp sử dụng Dictionary được không ?
Nhấp chuột vào đây để mở rộng...

- Nếu dữ liệu trong cột C (cột 1) của Data là các con số Thứ tự từ 1 đến ... mút chỉ thì đâu cần phải Dic.
Các bạn giúp đỡ Oanh Thơ code thay cho hàm Vlookup theo file đính kèm này với ạ.
Nhấp chuột vào đây để mở rộng...
- Code bên trên đã làm đúng yêu cầu: Code thay cho Vlookup() trong file của bạn.
- Nếu dữ liệu cột C (cột 1) của Data là các "ký tự lộn xộn" thì lại khác. Bạn thử code dưới.(Ví dụ của bạn phải tổng quát)
- Tên sheet nên cho nó 1 cái tên gì gì đó, chứ Sheet2 đặt tên là "Sheet1" thì "lãng" quá.
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), tArr(), I As Long, J As Long, R As Long, Col As Long, Rws As Long
With Sheets("Data")
    sArr = .Range("C5", .Range("C5").End(xlDown)).Resize(, 7).Value '7 = So cot cua Data'
End With
R = UBound(sArr)
With CreateObject("Scripting.Dictionary")
    For I = 1 To R
        .Add sArr(I, 1), I
    Next I
    With Sheets("Sheet1")
        tArr = .Range("C5", .Range("C5").End(xlDown)).Value
        R = UBound(tArr)
        Col = 5     '5 = So cot can lay du lieu cua Sheets(Sheet1)'
        ReDim dArr(1 To R, 1 To Col)
    End With
    For I = 1 To R
        If .Exists(tArr(I, 1)) Then
            Rws = .Item(tArr(I, 1))
            For J = 1 To Col
                dArr(I, J) = sArr(Rws, J + 1)
            Next J
        End If
    Next I
End With
Sheets("Sheet1").Range("D5").Resize(R, Col) = dArr
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
langtuchungtinh360 đã viết:
vì sao lại phải dùng Dictionary mới được vậy bạn. dữ liệu lớn thì Dic chưa chắc đã nhanh hơn mảng đâu, lý do muốn dùng Dictionary là gì (ngoài lọc duy nhất). đng tìm tòi tìm hiểu các thuật toán về vụ tìm kiếm, lọc thế này, được thì cứ đưa dữ liệu tràn lan đại hải lên. làm phát cho nhanh gọn đỡ phải lòi thêm phát sinh sau đó
Nhấp chuột vào đây để mở rộng...

Hi, cảm ơn bạn đã hỗ trợ ạ.
Oanh Thơ cũng không biết Dictionary dùng như thế nào nữa, vì lần trước Oanh Thơ có hỏi về vấn đề dùng code để thay thế cho hàm VLookup trong bài viết này, mình đã thấy bạn sử dụng Dictionary nên mới nghĩ vậy :)

https://www.giaiphapexcel.com/forum...hiều-sheet-theo-điều-kiện&p=764264#post764264

Nếu Dictionary đúng là chỉ lấy dữ liệu duy nhất thì không đúng với ý của Oanh Thơ rồi, vì trong cột C tại sheet1 của Oanh Thơ có rất nhiều dữ liệu trùng nhau.
 
Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
Hi, cảm ơn bạn đã hỗ trợ ạ.
Oanh Thơ cũng không biết Dictionary dùng như thế nào nữa, vì lần trước Oanh Thơ có hỏi về vấn đề dùng code để thay thế cho hàm VLookup trong bài viết này, mình đã thấy bạn sử dụng Dictionary nên mới nghĩ vậy :)

https://www.giaiphapexcel.com/forum...hiều-sheet-theo-điều-kiện&p=764264#post764264

Nếu Dictionary đúng là chỉ lấy dữ liệu duy nhất thì không đúng với ý của Oanh Thơ rồi, vì trong cột C tại sheet1 của Oanh Thơ có rất nhiều dữ liệu trùng nhau.
Nhấp chuột vào đây để mở rộng...
vậy bạn có tìm hiểu và biết chút gì về vba chưa.
nếu biết chút rồi thì tôi gửi cho bạn công cụ hỗ trợ thêm ,tôi tự tham khảo và viết - không nhiều chức năng như các công cụ khác, hiện vẫn dùng nó để soạn code, do nhiều lệnh, hàm quá nên đành tạo công cụ trợ giúp ấy mà.
 
Upvote 0
Ba Tê đã viết:
- Nếu dữ liệu trong cột C (cột 1) của Data là các con số Thứ tự từ 1 đến ... mút chỉ thì đâu cần phải Dic.

- Code bên trên đã làm đúng yêu cầu: Code thay cho Vlookup() trong file của bạn.
- Nếu dữ liệu cột C (cột 1) của Data là các "ký tự lộn xộn" thì lại khác. Bạn thử code dưới.(Ví dụ của bạn phải tổng quát)
- Tên sheet nên cho nó 1 cái tên gì gì đó, chứ Sheet2 đặt tên là "Sheet1" thì "lãng" quá.
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), tArr(), I As Long, J As Long, R As Long, Col As Long, Rws As Long
With Sheets("Data")
    sArr = .Range("C5", .Range("C5").End(xlDown)).Resize(, 7).Value '7 = So cot cua Data'
End With
R = UBound(sArr)
With CreateObject("Scripting.Dictionary")
    For I = 1 To R
        .Add sArr(I, 1), I
    Next I
    With Sheets("Sheet1")
        tArr = .Range("C5", .Range("C5").End(xlDown)).Value
        R = UBound(tArr)
        Col = 5     '5 = So cot can lay du lieu cua Sheets(Sheet1)'
        ReDim dArr(1 To R, 1 To Col)
    End With
    For I = 1 To R
        If .Exists(tArr(I, 1)) Then
            Rws = .Item(tArr(I, 1))
            For J = 1 To Col
                dArr(I, J) = sArr(Rws, J + 1)
            Next J
        End If
    Next I
End With
Sheets("Sheet1").Range("D5").Resize(R, Col) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...

Cảm ơn bạn Ba Tê rất nhiều Oanh Thơ sẽ dùng thử xem sao, nếu có vấn đề gì Oanh Thơ sẽ thông tin lại ạ.
 
Upvote 0
langtuchungtinh360 đã viết:
vậy bạn có tìm hiểu và biết chút gì về vba chưa.
nếu biết chút rồi thì tôi gửi cho bạn công cụ hỗ trợ thêm ,tôi tự tham khảo và viết - không nhiều chức năng như các công cụ khác, hiện vẫn dùng nó để soạn code, do nhiều lệnh, hàm quá nên đành tạo công cụ trợ giúp ấy mà.
Nhấp chuột vào đây để mở rộng...

Ôi thế thì tốt quá ạ,vậy bạn gửi cho Oanh Thơ để Oanh Thơ tìm hiểu nhé.
 
Upvote 0
Ba Tê đã viết:
- Nếu dữ liệu trong cột C (cột 1) của Data là các con số Thứ tự từ 1 đến ... mút chỉ thì đâu cần phải Dic.

- Code bên trên đã làm đúng yêu cầu: Code thay cho Vlookup() trong file của bạn.
- Nếu dữ liệu cột C (cột 1) của Data là các "ký tự lộn xộn" thì lại khác. Bạn thử code dưới.(Ví dụ của bạn phải tổng quát)
- Tên sheet nên cho nó 1 cái tên gì gì đó, chứ Sheet2 đặt tên là "Sheet1" thì "lãng" quá.
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), tArr(), I As Long, J As Long, R As Long, Col As Long, Rws As Long
With Sheets("Data")
    sArr = .Range("C5", .Range("C5").End(xlDown)).Resize(, 7).Value '7 = So cot cua Data'
End With
R = UBound(sArr)
With CreateObject("Scripting.Dictionary")
    For I = 1 To R
        .Add sArr(I, 1), I
    Next I
    With Sheets("Sheet1")
        tArr = .Range("C5", .Range("C5").End(xlDown)).Value
        R = UBound(tArr)
        Col = 5     '5 = So cot can lay du lieu cua Sheets(Sheet1)'
        ReDim dArr(1 To R, 1 To Col)
    End With
    For I = 1 To R
        If .Exists(tArr(I, 1)) Then
            Rws = .Item(tArr(I, 1))
            For J = 1 To Col
                dArr(I, J) = sArr(Rws, J + 1)
            Next J
        End If
    Next I
End With
Sheets("Sheet1").Range("D5").Resize(R, Col) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...

Cảm ơn Ba Tê , code đúng ý Oanh Thơ rồi ạ! Có 1 vấn đề Oanh Thơ chữa rõ mong bạn chỉ thêm cho ạ.
Khi sử dụng công thức Oanh Thơ muốn lấy giá trị nằm trong code nào thì chỉ cần sửa lại chỉ số col_index , ví dụ nếu lấy giá trị từ cột 3 mà không lấy giá trị từ cột 2 thì chỉ cần sửa lại chỉ số 2 thành 3.
Vậy trong code của bạn nếu muốn sửa chỉ số như col_index thì sẽ sửa chỗ nào ạ.
 
Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
Cảm ơn Ba Tê , code đúng ý Oanh Thơ rồi ạ! Có 1 vấn đề Oanh Thơ chữa rõ mong bạn chỉ thêm cho ạ.
Khi sử dụng công thức Oanh Thơ muốn lấy giá trị nằm trong code nào thì chỉ cần sửa lại chỉ số col_index , ví dụ nếu lấy giá trị từ cột 3 mà không lấy giá trị từ cột 2 thì chỉ cần sửa lại chỉ số 2 thành 3.
Vậy trong code của bạn nếu muốn sửa chỉ số như col_index thì sẽ sửa chỗ nào ạ.
Nhấp chuột vào đây để mở rộng...

Hổng hiểu luôn!
Làm như vầy cho tổng quát luôn, dù hơi mất công một chút:
- Tạo 1 dòng phụ, ghi chỉ số cột cần lấy của bảng Data vào dòng này
- Code sẽ lấy đúng số đó, muốn thay đổi gì thì thay trong dòng phụ này, không đụng tới code.
 

File đính kèm

Upvote 0
Ba Tê đã viết:
Hổng hiểu luôn!
Làm như vầy cho tổng quát luôn, dù hơi mất công một chút:
- Tạo 1 dòng phụ, ghi chỉ số cột cần lấy của bảng Data vào dòng này
- Code sẽ lấy đúng số đó, muốn thay đổi gì thì thay trong dòng phụ này, không đụng tới code.
Nhấp chuột vào đây để mở rộng...

Chào Bạn Ba Tê, đúng là cái rồi hihi, cảm ơn bạn nhiều!
Có 2 vấn đề nữa:
1.nếu dữ liệu trong Sheet"Data" không liên tục có dòng không có dữ liệu thì code chỉ lấy đến dòng cuối cùng trong mảng dữ liệu liền nhau mà không lấy dữ liệu đến dòng cuối cùng của bảng.
Ví dụ trong sheet"Data" Oanh Thơ xóa dữ liệu tại dòng 9 đi thì code chỉ tìm kiếm dữ liệu từ dòng 5 đến dòng 8 mà bỏ qua từ dòng 10 đến dòng 18.
2. thêm cột trong Sheet1 thì code bị lỗi

Làm phiền bạn nhiều quá ạ, thành thật xin lỗi vì Oanh Thơ không lường hết được các vấn đề

Bạn xem giúp vấn đề này với ạ.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
Chào Bạn Ba Tê, đúng là cái rồi hihi, cảm ơn bạn nhiều!
Có 1 vấn đề nữa nếu dữ liệu trong Sheet"Data" không liên tục có dòng không có dữ liệu thì code chỉ lấy đến dòng cuối cùng trong mảng dữ liệu liền nhau mà không lấy dữ liệu đến dòng cuối cùng của bảng.
Ví dụ trong sheet"Data" Oanh Thơ xóa dữ liệu tại dòng 9 đi thì code chỉ tìm kiếm dữ liệu từ dòng 5 đến dòng 8 mà bỏ qua từ dòng 10 đến dòng 18.
Bạn xem giúp vấn đề này với ạ.
Nhấp chuột vào đây để mở rộng...

Bạn tìm trong Sub dòng này:
PHP: 
sArr = .Range("C5", .Range("C5").End(xlDown)).Resize(, 7).Value '7 = So cot cua Data'
Thay bằng cái này:
PHP: 
sArr = .Range("C5", .Range("C1048576").End(xlUp)).Resize(, 7).Value    '7 = So cot cua Data'
 
Upvote 0
Ba Tê đã viết:
Bạn tìm trong Sub dòng này:
PHP: 
sArr = .Range("C5", .Range("C5").End(xlDown)).Resize(, 7).Value '7 = So cot cua Data'
Thay bằng cái này:
PHP: 
sArr = .Range("C5", .Range("C1048576").End(xlUp)).Resize(, 7).Value    '7 = So cot cua Data'
Nhấp chuột vào đây để mở rộng...

Hi, bạn trả lời nhanh thật
Oanh Thơ vừa sửa lại bài viết trên (_ _)
 
Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
Hi, bạn trả lời nhanh thật
Oanh Thơ vừa sửa lại bài viết trên (_ _)
Nhấp chuột vào đây để mở rộng...


Lúc muốn xóa dòng, lúc muốn chèn cột ... thì nếu đọc hiểu code chỉ cần chỉnh 1 chút thôi.
Rút kinh nghiệm, nếu bạn không thật hiểu code thì khi đưa dữ liệu phải giống như thật để người giúp làm 1 lần là đủ.
Nếu kết quả sai thì dẫn chứng chỗ sai.
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), tArr(), Lubu(), I As Long, J As Long, R As Long, Col As Long, Rws As Long
With Sheets("Data")
    sArr = .Range("C5", .Range("C1048576").End(xlUp)).Resize(, .Range("C4").End(xlToRight).Column - 2).Value
End With
R = UBound(sArr)
With CreateObject("Scripting.Dictionary")
    For I = 1 To R
        .Add sArr(I, 1), I
    Next I
    With Sheets("Sheet1")
        tArr = .Range("C5", .Range("C5").End(xlDown)).Value
        R = UBound(tArr)
        Col = .Range("E4", .Range("E4").End(xlToRight)).Columns.Count
        Lubu = .Range("E4").Resize(, Col).Value
        ReDim dArr(1 To R, 1 To Col)
    End With
    For I = 1 To R
        If .Exists(tArr(I, 1)) Then
            Rws = .Item(tArr(I, 1))
            For J = 1 To Col
                dArr(I, J) = sArr(Rws, Lubu(1, J))
            Next J
        End If
    Next I
End With
Sheets("Sheet1").Range("E5").Resize(R, Col) = dArr
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Ba Tê đã viết:
Lúc muốn xóa dòng, lúc muốn chèn cột ... thì nếu đọc hiểu code chỉ cần chỉnh 1 chút thôi.
Rút kinh nghiệm, nếu bạn không thật hiểu code thì khi đưa dữ liệu phải giống như thật để người giúp làm 1 lần là đủ.
Nếu kết quả sai thì dẫn chứng chỗ sai.
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), tArr(), Lubu(), I As Long, J As Long, R As Long, Col As Long, Rws As Long
With Sheets("Data")
    sArr = .Range("C5", .Range("C1048576").End(xlUp)).Resize(, .Range("C4").End(xlToRight).Column - 2).Value
End With
R = UBound(sArr)
With CreateObject("Scripting.Dictionary")
    For I = 1 To R
        .Add sArr(I, 1), I
    Next I
    With Sheets("Sheet1")
        tArr = .Range("C5", .Range("C5").End(xlDown)).Value
        R = UBound(tArr)
        Col = .Range("E4", .Range("E4").End(xlToRight)).Columns.Count
        Lubu = .Range("E4").Resize(, Col).Value
        ReDim dArr(1 To R, 1 To Col)
    End With
    For I = 1 To R
        If .Exists(tArr(I, 1)) Then
            Rws = .Item(tArr(I, 1))
            For J = 1 To Col
                dArr(I, J) = sArr(Rws, Lubu(1, J))
            Next J
        End If
    Next I
End With
Sheets("Sheet1").Range("E5").Resize(R, Col) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...

Cảm ơn ban Ba Tê vui tính và tốt bụng nhiều nhiều.
Oanh Thơ cũng đã gửi file mẫu giống với file thực. Nhưng quá trình sử dụng có thể xảy ra các tình huống mà Oanh Thơ đã hỏi thêm. Oanh Thơ chưa thể lường hết được các tình huống đó.
Xin lỗi bạn nhé.

Bạn có thể coment thêm vào mỗi dòng code để Oanh Thơ có thể hiểu và tự tùy biến được khi có sự thay đổi được không ạ.
 
Upvote 0
Code trên của bạn Ba Tê , trong sheet Data nếu số dòng không có dữ liệu liền nhau >=2 thì sẽ lỗi,xong lại hỏi --=0
 
Upvote 0
Tôi tải file kèm ở bài 42 về áp dụng với dữ liệu tại cột C là a,b,c thì không sử dụng được.
Nhờ Anh/Chị giúp đỡ.

Cảm ơn
 
Upvote 0
Upvote 0
Dòng đó để trong sheet nào vùng nào vậy Anh/Chị ơi, tôi tìm mãi không thấy.
 
Upvote 0
@@! Sao nhìn loằng ngoằng vậy Anh/Chị?
Thôi tôi dùng công thức,híc.

Cảm ơn Anh/Chị.
 
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
  • Question Question
Viết code tìm kiếm các file trong Folder (1 người xem)
Trả lời
36
Đọc
12K
lan nguyen0987
L
C
Fix lỗi Application.InputBox Type:=8 (1 người xem)
    • Cười
Trả lời
21
Đọc
549
cdshtz88
C
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
4
Đọc
53
ptm0412
ptm0412
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
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
55
Đọc
22K
Gà Con yêu VBA
Gà Con yêu VBA
ptm0412
Quá tin tưởng vào AI các thể loại
    • Cười
Trả lời
4
Đọc
152
Maika8008
Maika8008
A
  • Question Question
Không tìm được lỗi code
Trả lời
6
Đọc
99
ptm0412
ptm0412
SA_DQ
Copilot bình luận về một ván cờ vua
    • Thích
Trả lời
5
Đọc
372
SA_DQ
SA_DQ
W
Tham chiếu theo chuỗi ký tự
Trả lời
8
Đọc
288
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
257
BlueSphere
B
GPE-Trợ Lý
MỪNG NGÀY NHÀ GIÁO VIỆT NAM 20/11 (5 người xem)
    • Thích
Trả lời
0
Đọc
904
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
111
BuiQuangThuan
B
M
chuyển đổi số thành chữ
Trả lời
15
Đọc
311
dungpham01
D
V
Lỗi copy sheet: the name already exists.
Trả lời
7
Đọc
683
nghiabros
N
L
Nhờ hỗ trợ tìm hàm excel trả về giá trị
Trả lời
4
Đọc
120
lechuong174
L
SA_DQ
Copilot & giúp hỗ trợ nhập các ký tự đặt biệt
    • Thích
Trả lời
0
Đọc
84
SA_DQ
SA_DQ
GPE-Trợ Lý
[GPE20] BIỂU ĐỒ CHUYÊN NGHIỆP: PHÁ VỠ GIỚI HẠN 2 TRỤC CỦA EXCEL (2 người xem)
    • Thích
    • Yêu thích
Trả lời
1
Đọc
4K
GPE-Trợ Lý
GPE-Trợ Lý
hadu8889
EXCEL TỰ ĐỘNG ĐÓNG KHI SỬA TEXT Ở TRÊN USERFORM (1 người xem)
Trả lời
10
Đọc
250
LOGANWover
L
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (3 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
4 5 6
Trả lời
565
Đọc
78K
lacmatquan
L
H
Lấy giá trị format trong ô của excel
Trả lời
2
Đọc
172
LOGANWover
L
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