Chuyên đề giải đáp những thắc mắc về code VBA (12 người xem)

maytinhvp01 · 31/7/13

Mình muốn nhờ giải thich câu lệnh " If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c) "
trong ví du:
Public Function LonNhat(Ran As Range)
Dim max As Double, v As Integer, d As Integer, c As Integer
max = Ran.Cells(1, 1)
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c)
Next c
Next d
v = Tim(max, Ran)
LonNhat = max
End Function
-------------------------------------------------------
[INFO1]Thông báo:
Vì topic này:
http://www.giaiphapexcel.com/forum/...ải-thích-các-code-đề-nghị-các-bạn-gửi-vào-đây
đã quá dài nên BQT đóng lại.
Nay tôi mở topic mới với cùng chủ đề: GIẢI THÍCH NHỮNG THẮC MẮC VỀ CODE
Các bạn nếu có nhu cầu giải thích code, vui lòng post tại đây nhé
NDU96081631
[/INFO1]

Thong Hoang Tien 250691 · 25/11/19

tonnydung đã viết:
Em nhờ các bác giúp 4 trường hợp sau giúp:

1/ Code VBA để coppy sau VD: Sheet 1
Khi ta dang Mở File A ở Sheet 1 có 1 nút "coppy" Khi click vào Nút "Coppy" thì Coppy tất cả các hàng trong Sheet1 File C những cột A,B,C,D Nếu thỏa cột B có chữ "nhà xe" vào Sheet1 File A

2/ Code VBA để coppy sau VD: Sheet 2
Khi ta dang Mở Sheet2 File A ở Sheet 2 có 1 nút "coppy" Khi click vào Nút "Coppy" thì Coppy tất cả các hàng trong Sheet2 File C những cột A,B,C,D,E,F,G,H,I,K Nếu thỏa cột C Không có chữ "HQ" vào Sheet2 File A

3/ Code VBA để coppy sau VD: Sheet 3
Khi dang lam viec o Sheet3 FileA có các hàng dữ liệu liền nhau có các cột A,B,C,D,E và trong sheet đó có nút Coppy. Nếu Click vào nút Coppy mà thỏa mãn 2 điều kiện sau:
- Dieu kien 1: cột A trong Sheet3 FileC và cột A Sheet3 FileA (sheet và file hiện thời làm việc) có số số liệu trùng nhau.
- Dieu kien 2: cột F trong Sheet3 FileC không có dấu "x"
thì sẽ coppy các dữ liệu của các hàng ở Cột C,D,E của Sheet3 FileC sang các cột C,D,E của Sheet3 FileA
(lưu ý giúp: dữ liệu hãng ở Sheet3 FileA có thể ko liền nhau)

4/ Code VBA trong Form VD: Sheet 4
Trong 1 Form có 2 text boxt sau:
Text boxt 1, Text boxt 2
Khi nhập dữ liệu vào Text boxt 1 bấm enter thì Text boxt 2 ktra 3 ký tự đầu của
Text boxt 1 nếu có 3 chữ "kle" thì Text boxt 2 sẽ tự điền là "kh" còn ko có Text boxt 2 sẽ điền "nhà xe"

Anh đọc lại nội quy đăng bài nhé. "2. Không được viết một câu hỏi nhiều lần hay gửi cùng một câu hỏi trong nhiều box khác nhau. Khi câu hỏi chưa được trả lời thì không có nghĩa là không ai biết thông tin liên quan đến câu hỏi của bạn và mọi người đang tìm thông tin để trả lời cho câu hỏi đó. "
Câu hỏi của anh em đã trả lời ở bên kia rồi.

tonnydung · 26/11/19

Vì có những vẫn đề phát sinh và gửi nhầm sang chủ đề Form nên em xin gửi lại ở đây nhờ các bác giúp 3 trường hợp sau giúp:

1/ Code VBA để coppy sau VD: Sheet 1
Khi ta dang Mở File A ở Sheet1 có 1 nút "coppy" Khi click vào Nút "Coppy" thì Coppy tất cả các hàng trong Sheet4 File C những cột A,B,C,D Nếu thỏa 2 điều kiện sau:
1/ cột B ở Sheet4 FileC có chữ "nhà xe"
2/ Nếu Sheet1 FileA cột A,C,D có thông tin trùng nhau thì Coppy đè lên cái đã có ở Sheet1 File A

(Lưu ý: Làm sao ko cần mở file mà vẫn coppy được)

2/ Code VBA để coppy sau VD: Sheet 2
Khi ta dang Mở Sheet2 File A ở Sheet2 có 1 nút "coppy" Khi click vào Nút "Coppy" thì Coppy tất cả các hàng trong Sheet5 File C những cột A,B,C,D,E,F,G,H,I,K Nếu thỏa mãn cột C Không có chữ "HQ" vào Sheet2 File A => Để ko coppy nhiều lần nếu cột B,C,E của FileA trùng với dữ liệu sẽ coppy ở FileC sang thì sẽ ghi đè lên Sheet2 ở FileA

(Lưu ý: Làm sao ko cần mở file mà vẫn coppy được)

3/ Code VBA để coppy sau VD: Sheet 3
Khi dang lam viec o Sheet3 FileA có các hàng dữ liệu liền nhau có các cột A,B,C,D,E,F,G,H,I,J,K và trong sheet đó có nút Coppy. Nếu Click vào nút Coppy mà thỏa mãn 2 điều kiện sau:
- Dieu kien 1: cột B trong Sheet6 FileC và cột A Sheet3 FileA (sheet và file hiện thời làm việc) có số liệu trùng nhau.
- Dieu kien 2: cột F trong Sheet6 FileC ở cột F, K không có dấu "x"
thì sẽ coppy các dữ liệu của các hàng ở Cột D,E,F,H,I,J của Sheet6 FileC sang các cột C,D,E, H,I,J của Sheet3 FileA
(lưu ý giúp: dữ liệu hãng ở Sheet3 FileA có thể ko liền nhau)

(Lưu ý: Làm sao ko cần mở file mà vẫn coppy được)

Rất mong được giúp đỡ vì em rất cần. Tks

tonnydung · 27/11/19

tonnydung đã viết:
Vì có những vẫn đề phát sinh và gửi nhầm sang chủ đề Form nên em xin gửi lại ở đây nhờ các bác giúp 3 trường hợp sau giúp:

1/ Code VBA để coppy sau VD: Sheet 1
Khi ta dang Mở File A ở Sheet1 có 1 nút "coppy" Khi click vào Nút "Coppy" thì Coppy tất cả các hàng trong Sheet4 File C những cột A,B,C,D Nếu thỏa 2 điều kiện sau:
1/ cột B ở Sheet4 FileC có chữ "nhà xe"
2/ Nếu Sheet1 FileA cột A,C,D có thông tin trùng nhau thì Coppy đè lên cái đã có ở Sheet1 File A

(Lưu ý: Làm sao ko cần mở file mà vẫn coppy được)

2/ Code VBA để coppy sau VD: Sheet 2
Khi ta dang Mở Sheet2 File A ở Sheet2 có 1 nút "coppy" Khi click vào Nút "Coppy" thì Coppy tất cả các hàng trong Sheet5 File C những cột A,B,C,D,E,F,G,H,I,K Nếu thỏa mãn cột C Không có chữ "HQ" vào Sheet2 File A => Để ko coppy nhiều lần nếu cột B,C,E của FileA trùng với dữ liệu sẽ coppy ở FileC sang thì sẽ ghi đè lên Sheet2 ở FileA

(Lưu ý: Làm sao ko cần mở file mà vẫn coppy được)

3/ Code VBA để coppy sau VD: Sheet 3
Khi dang lam viec o Sheet3 FileA có các hàng dữ liệu liền nhau có các cột A,B,C,D,E,F,G,H,I,J,K và trong sheet đó có nút Coppy. Nếu Click vào nút Coppy mà thỏa mãn 2 điều kiện sau:
- Dieu kien 1: cột B trong Sheet6 FileC và cột A Sheet3 FileA (sheet và file hiện thời làm việc) có số liệu trùng nhau.
- Dieu kien 2: cột F trong Sheet6 FileC ở cột F, K không có dấu "x"
thì sẽ coppy các dữ liệu của các hàng ở Cột D,E,F,H,I,J của Sheet6 FileC sang các cột C,D,E, H,I,J của Sheet3 FileA
(lưu ý giúp: dữ liệu hãng ở Sheet3 FileA có thể ko liền nhau)

(Lưu ý: Làm sao ko cần mở file mà vẫn coppy được)

Rất mong được giúp đỡ vì em rất cần. Tks

rất mong được sự giúp đỡ. tks

vova2209 · 12/12/19

Chào anh chị! em hỏi về vòng for
cho em xin code về vòng for i = "chọn nhiều ô cell". VD vòng for mình muốn chạy thì chọn ô A1, A5, A7, A8 hoặc quét 1 dãy từ A1~A10 ở những ô đó lấy được giá trị cho vào vòng for

batman1 · 12/12/19

vova2209 đã viết:
Chào anh chị! em hỏi về vòng for
cho em xin code về vòng for i = "chọn nhiều ô cell". VD vòng for mình muốn chạy thì chọn ô A1, A5, A7, A8 hoặc quét 1 dãy từ A1~A10 ở những ô đó lấy được giá trị cho vào vòng for

Mã:

Sub test()
Dim cell_ As Range
    For Each cell_ In Application.Selection
'        ...
    Next cell_
End Sub

vova2209 · 12/12/19

batman1 đã viết:
Mã:

Sub test() Dim cell_ As Range For Each cell_ In Application.Selection ' ... Next cell_ End Sub

Xem hộ em lỗi đâu không in được

Mã:

Sub InBB_PhieuBeTong()
    Dim sRng As Range
    Dim Ws As Worksheet
    ActiveSheet.DisplayPageBreaks = False
    
    'On Error GoTo Thoat
    Set sRng = Application.InputBox(Prompt:="Chon Du liêu IN", Title:="Vùng Data", Type:=8)
    For Each sRng In Selection
        Sheets("6.Ctiet BT").Select
        With Ws
            ActiveSheet.DisplayPageBreaks = False
            .Range("AZ1").Value = sRng.Value
            .PrintOut 'Vùng in Set
            End With
    Next sRng
'Thoat:
    ActiveSheet.DisplayPageBreaks = False
End Sub

snow25 · 12/12/19

vova2209 đã viết:

Xem hộ em lỗi đâu không in được

Mã:

Sub InBB_PhieuBeTong()
    Dim sRng As Range
    Dim Ws As Worksheet
    ActiveSheet.DisplayPageBreaks = False
   
    'On Error GoTo Thoat
    Set sRng = Application.InputBox(Prompt:="Chon Du liêu IN", Title:="Vùng Data", Type:=8)
    For Each sRng In Selection
        Sheets("6.Ctiet BT").Select
        With Ws
            ActiveSheet.DisplayPageBreaks = False
            .Range("AZ1").Value = sRng.Value
            .PrintOut 'Vùng in Set
            End With
    Next sRng
'Thoat:
    ActiveSheet.DisplayPageBreaks = False
End Sub

Bạn sửa thành for each t in srng thì được.trong đó t là 1 biến range.và thay câu lệnh ở dưới là biến t nhé.

batman1 · 12/12/19

vova2209 đã viết:

Xem hộ em lỗi đâu không in được

Mã:

Sub InBB_PhieuBeTong()
    Dim sRng As Range
    Dim Ws As Worksheet
    ActiveSheet.DisplayPageBreaks = False
  
    'On Error GoTo Thoat
    Set sRng = Application.InputBox(Prompt:="Chon Du liêu IN", Title:="Vùng Data", Type:=8)
    For Each sRng In Selection
        Sheets("6.Ctiet BT").Select
        With Ws
            ActiveSheet.DisplayPageBreaks = False
            .Range("AZ1").Value = sRng.Value
            .PrintOut 'Vùng in Set
            End With
    Next sRng
'Thoat:
    ActiveSheet.DisplayPageBreaks = False
End Sub

1. Nếu trước khi nhấn nút mà ô vd. BB64 đang được chọn thì Selection trong For Each sRng In Selection nó là 1 ô BB64 chứ không phải 2 ô vừa chọn ở 6.DV BT
2. Nếu đã chọn bằng InputBox thì các ô được chọn nó ở trong sRng rồi, sao lại dùng Selection?
3.

Mã:

With Ws
    ActiveSheet.DisplayPageBreaks = False
    .Range("AZ1").Value = sRng.Value
    .PrintOut 'Vůng in Set
End With

Chưa có SET nên Ws là Nothing và do vậy sẽ có lỗi tại

Mã:

.Range("AZ1").Value = sRng.Value
.PrintOut 'Vůng in Set

Cũng có thể không dùng Ws và SET mà dùng With Sheets("6.Ctiet BT")

4. Hãy hạn chế SELECT kiểu Sheets("6.Ctiet BT").Select. Không cần thiết.

Mã:

Sub InBB_PhieuBeTong()
    Dim sRng As Range, cell_ As Range
    'On Error GoTo Thoat
    ActiveSheet.DisplayPageBreaks = False
    Set sRng = Application.InputBox(Prompt:="Chon Du lięu IN", Title:="Vůng Data", Type:=8)
    For Each cell_ In sRng
        With Sheets("6.Ctiet BT")
            .Range("AZ1").Value = cell_.Value
            .PrintOut 'Vůng in Set
        End With
    Next cell_
'Thoat:
End Sub

batman1 · 12/12/19

snow25 đã viết:
Bạn sửa thành for each t in srng thì được.trong đó t là 1 biến range.và thay câu lệnh ở dưới là biến t nhé.

Thực ra vụ For Each sRng In Selection chỉ là nhập nhầm giá trị ô vào AZ1. Ví dụ trước khi nhấn nút mà BB64 được chọn thì Selection là BB64 và giá trị của BB64 sẽ được nhập vào AZ1. Nhưng đây là lỗi "kết quả không như mong đợi". Còn lỗi thực sự, lỗi thực hiện, "cho đi về với cát bụi" là lỗi do chưa có SET nên Ws = Nothing. Lúc đó thực hiện

Mã:

.Range("AZ1").Value = ...
.PrintOut 'Vůng in Set

sẽ có lỗi "đột quỵ"

vova2209 · 12/12/19

batman1 đã viết:
1. Nếu trước khi nhấn nút mà ô vd. BB64 đang được chọn thì Selection trong For Each sRng In Selection nó là 1 ô BB64 chứ không phải 2 ô vừa chọn ở 6.DV BT
2. Nếu đã chọn bằng InputBox thì các ô được chọn nó ở trong sRng rồi, sao lại dùng Selection?
3.

Mã:

With Ws ActiveSheet.DisplayPageBreaks = False .Range("AZ1").Value = sRng.Value .PrintOut 'Vůng in Set End With

Chưa có SET nên Ws là Nothing và do vậy sẽ có lỗi tại

Mã:

.Range("AZ1").Value = sRng.Value .PrintOut 'Vůng in Set

Cũng có thể không dùng Ws và SET mà dùng With Sheets("6.Ctiet BT")

4. Hãy hạn chế SELECT kiểu Sheets("6.Ctiet BT").Select. Không cần thiết.

Mã:

Sub InBB_PhieuBeTong() Dim sRng As Range, cell_ As Range 'On Error GoTo Thoat ActiveSheet.DisplayPageBreaks = False Set sRng = Application.InputBox(Prompt:="Chon Du lięu IN", Title:="Vůng Data", Type:=8) For Each cell_ In sRng With Sheets("6.Ctiet BT") .Range("AZ1").Value = cell_.Value .PrintOut 'Vůng in Set End With Next cell_ 'Thoat: End Sub

Được rồi anh à!, em cũng quên toàn dùng Sheets("6.Ctiet BT").Select Các anh cũng nhắc mà em quên mất

Jung heo · 17/12/19

Kính nhờ anh chị sửa giúp code trong file đính kèm ạ. E đang muốn tách từ dòng thứ 3 nhưng file tách này đang tách từ dòng 1

doanminh00 · 18/12/19

Các bác cho mỉnh tí với.
Tình hình là mình có 1 bảng dữ liệu excel. Mình muốn từ bảng đấy mình mở 1 file word mà mình muốn merge đến vị trí mình mong muốn được không vậy.
Thanks các bác ạ!

batman1 · 18/12/19

doanminh00 đã viết:
Các bác cho mỉnh tí với.
Tình hình là mình có 1 bảng dữ liệu excel. Mình muốn từ bảng đấy mình mở 1 file word mà mình muốn merge đến vị trí mình mong muốn được không vậy.
Cảm ơn các bác ạ!

Đính kèm tập tin rồi dựa vào nó mô tả công việc. Làm gì, khi nào, như thế nào v...v thì may có người giúp. Còn nếu chỉ là một chút nước bọt thì chịu.
Nếu chỉ muốn câu trả lời "được" hay "không được" thì "được".

ladori · 23/12/19

Chào mọi người ạ,

Em đang làm 1 file excel có thể tự nhập những thông tin vào sheet "Hàng xuất" từ sheet "Phiếu xuất hàng" khi nhấn nút "Lưu"
Nhưng khi em chạy thử thì nó bị lỗi này ạ "Compile error: Variable not defined"

Mong mọi người hướng dẫn em với ạ! Em xin cảm ơn!!

Code em làm theo hướng dẫn trên mạng ạ! EM CÓ ĐÍNH KÈM FILE MẪU VÀ HÌNH ẢNH

Mã:

Option Explicit

Sub Lenh_Luu()

With Sheet1

'Mo khoa sheet

    .Unprotect

'Tim dong tiep theo trong bang xuat kho

    Dim Dongcuoi As Long

        Dongcuoi = Sheet1.Cells(Rows.Count, 1).End(x1Up).Row + 1  'Dong cuoi cot A

'Luu noi dung vao cac cot

    Cells(Dongcuoi, 1).Value = Sheet2.Cells(15, 1).Value  'Ma Don

    Cells(Dongcuoi, 2).Value = Sheet2.Cells(15, 2).Value  'Ngay

    Cells(Dongcuoi, 3).Value = Sheet2.Cells(15, 3).Value  'Ma KH

    Cells(Dongcuoi, 4).Value = Sheet2.Cells(15, 4).Value  'Nguoi nhan hang

    Cells(Dongcuoi, 5).Value = Sheet2.Cells(15, 5).Value  'STT

    Cells(Dongcuoi, 6).Value = Sheet2.Cells(15, 6).Value  'Ma So

    Cells(Dongcuoi, 7).Value = Sheet2.Cells(15, 7).Value  'Ten San Pham

    Cells(Dongcuoi, 8).Value = Sheet2.Cells(15, 8).Value  'So Luong

    Cells(Dongcuoi, 9).Value = Sheet2.Cells(15, 9).Value  'Don Gia

    Cells(Dongcuoi, 10).Value = Sheet2.Cells(15, 10).Value  'Thanh Tien

    Cells(Dongcuoi, 11).Value = Sheet2.Cells(15, 11).Value  'Ghi Chu

'Khoa sheet

    .Protect

End With

'Thong bao hoan thanh

MsgBox "Luu thanh cong"

End Sub

BuiQuangThuan · 23/12/19

ladori đã viết:
Chào mọi người ạ,

Em đang làm 1 file excel có thể tự nhập những thông tin vào sheet "Hàng xuất" từ sheet "Phiếu xuất hàng" khi nhấn nút "Lưu"
Nhưng khi em chạy thử thì nó bị lỗi này ạ "Compile error: Variable not defined"

Mong mọi người hướng dẫn em với ạ! Em xin cảm ơn!!

Code em làm theo hướng dẫn trên mạng ạ! EM CÓ ĐÍNH KÈM FILE MẪU VÀ HÌNH ẢNH

Dòng này của bạn bị sai nè:

Mã:

Dongcuoi = Sheet1.Cells(Rows.Count, 1).End(x1Up).Row + 1  'Dong cuoi cot A

Sửa lại thành:

Mã:

Dongcuoi = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row + 1  'Dong cuoi cot A

ladori · 23/12/19

buiquangthuan đã viết:
Dòng này của bạn bị sai nè:

Mã:

Dongcuoi = Sheet1.Cells(Rows.Count, 1).End(x1Up).Row + 1 'Dong cuoi cot A

Sửa lại thành:

Mã:

Dongcuoi = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row + 1 'Dong cuoi cot A

Dạ em cảm ơn rất nhiều ạ! Mà anh cho em hỏi lại cái là sao e nhìn thì thấy nó ko khác gì cái dòng của e hết. Mà thay vào thì nó chạy được!
Với lại khi nó chạy thì thay vì nhập vô sheet "Xuất Kho" thì nó lại thêm vô đúng sheet "Phiếu xuất" và chen vô lưng chừng ạ

Đây là hình trước và sau khi chạy ạ

BuiQuangThuan · 23/12/19

ladori đã viết:
Dạ em cảm ơn rất nhiều ạ! Mà anh cho em hỏi lại cái là sao e nhìn thì thấy nó ko khác gì cái dòng của e hết. Mà thay vào thì nó chạy được!
Với lại khi nó chạy thì thay vì nhập vô sheet "Xuất Kho" thì nó lại thêm vô đúng sheet "Phiếu xuất" và chen vô lưng chừng ạ

Đây là hình trước và sau khi chạy ạ

Quên mất là phải nói với bạn. Sai ở cái chỗ xlup chứ không phải x1up.
Bạn nói rõ hơn 1 xíu được không. Tại thấy có sheets nào tên "Xuất Kho" và Phiếu xuất đâu

ladori · 23/12/19

buiquangthuan đã viết:
Quên mất là phải nói với bạn. Sai ở cái chỗ xlup chứ không phải x1up.
Bạn nói rõ hơn 1 xíu được không. Tại thấy có sheets nào tên "Xuất Kho" và Phiếu xuất đâu

Hic, xin lỗi bác! Em quên mất là em đặt tên sheet viết tắt
Nó là Sheet "QLXK" (quản lý xuất kho) với Sheet "PXK" (phiếu xuất kho) đó bác

Hoàng Nhật Phương · 28/12/19

Xin chào các bạn,
Nhờ các bạn giúp đỡ OT trường hợp sau với ạ:

Trong cửa sổ Name của Excel OT đặt 1 name có tên MyName và gán công thức:

Mã:

MyName ="(s.FDATE >= N'"&TEXT(PRODUCTION!$B$2,"yyymmdd")&"1') and (s.FDATE <= N'"&TEXT(PRODUCTION!$B$3,"yyymmdd")&"1')"& IF(PRODUCTION!$F$3<>""," and (s.BUMO Like N'%"&PRODUCTION!$F$3&"%')","")&IF(PRODUCTION!$D$3<>""," and (s.LOTNAME Like N'%" &PRODUCTION!$D$3& "%')","")& IF(PRODUCTION!$D$2<>""," and (s.CODE Like N'%"&PRODUCTION!$D$2& "%')","")&IF(PRODUCTION!$F$2<>""," and (s.PORDER Like N'%"&PRODUCTION!$F$2&"%')","")

Khi nhập
=MyName xuống bảng tính sẽ được giá trị (kết quả)

Nhưng trong Vba OT viết:
ThisWorkbook.Names("MyName")
Thì code không ra giá trị như nhập xuống bảng tính mà ra công thức OT đã gán vào Name

Vậy phải viết như thế nào trong vba để OT có thể lấy được kết quả giống như nhập =MyName trên bảng tính.

nguoiconxunui · 28/12/19

thử xem:
Application.Evaluate(ThisWorkbook.Names("MyName ").Value)

Hoàng Nhật Phương · 28/12/19

nguoiconxunui đã viết:
thử xem:
Application.Evaluate(ThisWorkbook.Names("MyName ").Value)

Cảm ơn bạn đã giúp đỡ, OT thử:
MsgBox Application.Evaluate(ThisWorkbook.Names("MyName").Value)
thì báo lỗi:
Type mismatch (Error 13)
Nhờ bạn xem giúp ạ.

nguoiconxunui · 28/12/19

Nguyễn Hoàng Oanh Thơ đã viết:
Cảm ơn bạn đã giúp đỡ, OT thử:
MsgBox Application.Evaluate(ThisWorkbook.Names("MyName").Value)
thì báo lỗi:
Type mismatch (Error 13)
Nhờ bạn xem giúp ạ.

Vậy phải xem giá trị của bạn trả về là gì? dùng msgbox thì convert giá trị về string trước.

Hoàng Nhật Phương · 28/12/19

nguoiconxunui đã viết:
Vậy phải xem giá trị của bạn trả về là gì? dùng msgbox thì convert giá trị về string trước.

Dạ giá trị trả về kiểu String ạ,OT cũng đã khai báo một biến txt as string, sau đó gán
txt = Application.Evaluate(ThisWorkbook.Names("MyName").Value)
MsgBox txt
Nhưng vẫn báo lỗi Type mismatch ạ.

XuanThanh · 28/12/19

Muốn thử thì dùng Debug.Print chứ đừng dùng MsgBox
Sub Thu()
Dim GiaTri
GiaTri = Application.Evaluate(ThisWorkbook.Names("MyName").Value)
Debug.Print GiaTri
End Sub

Chạy code xem thử trong cửa sổ Immediate nó nói gì

Hoàng Nhật Phương · 28/12/19

XuanThanh đã viết:
Muốn thử thì dùng Debug.Print chứ đừng dùng MsgBox
Sub Thu()
Dim GiaTri
GiaTri = Application.Evaluate(ThisWorkbook.Names("MyName").Value)
Debug.Print GiaTri
End Sub

Chạy code xem thử trong cửa sổ Immediate nó nói gì

Cảm ơn bạn đã quan tâm ạ, code lỗi ngay tại dòng gán này rồi ạ:
GiaTri = Application.Evaluate(ThisWorkbook.Names("MyName").Value)

XuanThanh · 28/12/19

Set GiaTri =....

Hoàng Nhật Phương · 28/12/19

XuanThanh đã viết:
Set GiaTri =....

nó vẫn lỗi vậy bạn ạ T_T

VetMini · 28/12/19

Debug thì phải thử từ trong ra ngoài chứ.
nếu lỗi ở:
vw = cái gì đó & cái gì đó thứ 2
abc = def( xyz( vw ) )
thì đầu tiên hết phải debug vw, nếu thoả mãn thì tiếp theo là xyz( vw )...

nguoiconxunui · 28/12/19

Thử xem:

Debug.print Join(Application.Evaluate(ThisWorkbook.Names("MyName").Value) ) ' Áp dụng khi kết quả trả về dạng array

Hoặc, add watch :

Hoàng Nhật Phương · 28/12/19

VetMini đã viết:
Debug thì phải thử từ trong ra ngoài chứ.
nếu lỗi ở:
vw = cái gì đó & cái gì đó thứ 2
abc = def( xyz( vw ) )
thì đầu tiên hết phải debug vw, nếu thoả mãn thì tiếp theo là xyz( vw )...

Cảm ơn Bác đã quan tâm và chỉ dẫn cho con.

nguoiconxunui đã viết:
Thử xem:

Debug.print Join(Application.Evaluate(ThisWorkbook.Names("MyName").Value) ) ' Áp dụng khi kết quả trả về dạng array

Dạ code vẫn bị lỗi như cũ Bạn ạ

Name này chỉ trả về một giá trị, ví dụ:
(s.FDATE >= N'201912211') and (s.FDATE <= N'201912241') and (s.BUMO Like N'%BUR-%')

OT làm thử như sau:
Dim txt as string
Range("A1").Value = "=MyName"
txt = Range("A1").Value
Debug.Print txt

Giá trị trả về đúng ý OT ạ:
(s.FDATE >= N'201912211') and (s.FDATE <= N'201912241') and (s.BUMO Like N'%BUR-%')

HeSanbi · 28/12/19

Nguyễn Hoàng Oanh Thơ đã viết:
Dạ giá trị trả về kiểu String ạ,OT cũng đã khai báo một biến txt as string, sau đó gán
txt = Application.Evaluate(ThisWorkbook.Names("MyName").Value)
MsgBox txt
Nhưng vẫn báo lỗi Type mismatch ạ.

Name trong Excel sử dụng Macro4.0 lỗi thời:
Application.ExecuteExcel4Macro(ThisWorkbook.Names("MyName").Value)

Hoàng Nhật Phương · 28/12/19

HeSanbi đã viết:
Name trong Excel sử dụng Macro4.0 lỗi thời:
Application.ExecuteExcel4Macro(ThisWorkbook.Names("MyName").Value)

Cảm ơn HeSanbi, OT viết:
txt = Application.ExecuteExcel4Macro(ThisWorkbook.Names("MyName").Value)
Debug.Print txt
Code thông báo lỗi tại txt=...

T_T

HeSanbi · 28/12/19

Nguyễn Hoàng Oanh Thơ đã viết:
Cảm ơn HeSanbi, OT viết:
txt = Application.ExecuteExcel4Macro(ThisWorkbook.Names("MyName").Value)
Debug.Print txt
Code thông báo lỗi tại txt=...

1. ExecuteExcel4Macro chưa được kích hoạt
2. Phương thức Macro4.0 chưa chắc đã gọi được trong VBA.
3. Vì sao không chuyển Name kia thành hẳn VBA?

s.FDate OT hiểu nó như thế nào?

Vì sao phải dùng đến phương thức Execute

Hoàng Nhật Phương · 28/12/19

HeSanbi đã viết:
1. ExecuteExcel4Macro chưa được kích hoạt
2. Phương thức Macro4.0 chưa chắc đã gọi được trong VBA.
3. Vì sao không chuyển Name kia thành hẳn VBA?

s.FDate OT hiểu nó như thế nào?

Vì sao phải dùng đến phương thức Execute

Dạ "s.FDate" s được gán cho một Bảng trong môi trường SQL còn FDATE là trường của bảng đó ạ.
chuyển Name kia thành hẳn VBA thì viết sao vậy HeSanbi, nhờ bạn giúp đỡ ạ.

HeSanbi · 28/12/19

Nguyễn Hoàng Oanh Thơ đã viết:
Dạ "s.FDate" s được gán cho một Bảng trong môi trường SQL còn FDATE là trường của bảng đó ạ.
chuyển Name kia thành hẳn VBA thì viết sao vậy HeSanbi, nhờ bạn giúp đỡ ạ.

Phương thức Execute Sẽ tìm kiếm Hàm và phương thức đã được khởi tạo trước đó.

Đoạn này là một chuỗi phải không?

(s.FDATE >= N'201912211') and (s.FDATE <= N'201912241') and (s.BUMO Like N'%BUR-%')

s.FDATE và s.BUMO thuộc môi trường SQL đã được tạo để VBA hiểu chưa.

Vậy Execute sẽ tìm s.FDate ở đâu?

----------------------------------------------------------

Khởi tạo toàn bộ kết nối SQL sau đó:

Dim SQL As String
SQL = "(s.FDATE >= N'201912211') and (s.FDATE <= N'201912241') and (s.BUMO Like N'%BUR-%')"

Chuyển đoạn:
"(s.FDATE >= N'"&TEXT(PRODUCTION!$B$2,"yyymmdd")&"1') and (s.FDATE <= N'"&TEXT(PRODUCTION!$B$3,"yyymmdd")&"1')"& IF(PRODUCTION!$F$3<>""," and (s.BUMO Like N'%"&PRODUCTION!$F$3&"%')","")&IF(PRODUCTION!$D$3<>""," and (s.LOTNAME Like N'%" &PRODUCTION!$D$3& "%')","")& IF(PRODUCTION!$D$2<>""," and (s.CODE Like N'%"&PRODUCTION!$D$2& "%')","")&IF(PRODUCTION!$F$2<>""," and (s.PORDER Like N'%"&PRODUCTION!$F$2&"%')","")

Thành:
1. Sửa Range:

PRODUCTION!$B$2

-> Dim B2 As String: B2 = Application.Text(Worksheets("PRODUCTION").[B2].Value, "yyymmdd")

2. Sửa Hàm:

TEXT -> Application.Text Hoặc VBA.Format

IF -> VBA.IFF

Kết quả:
SQL = "(s.FDATE >= N'" & B2 & ...

VetMini · 28/12/19

Khi thiết lập một câu SQL có nhiều thông số/tham số thì người có kinh nghiệm sẽ không dùng thể loại:
Lệnh & 'tham số 1' & lệnh & tham số 2 & ....
Một đống &, đóng quote mở quote tùm lum. Xác suất viết sai khá cao.

Để tránh viết sai, và cũng dễ đọc câu SQL, người ta dùng cách SQL động giả (emulate) command parameters:
Const SQLCOMMAND = "lệnh <tham1> lệnh <tham2> ..."
SQLstr = Replace(Replace(SQLCOMMAND, "<tham1>", tham số 1), "<tham2>", tham số 2)
Có bao nhiêu tham số thì bấy nhiêu Replace.
Câu SQLCOMMAND đọc dễ hiểu hơn nhiều.

duonghychi · 3/1/20

Mong các anh chị giúp đỡ ạ.
Em có đoạn code sưu tầm như dưới, khi em nhập dữ liệu từ ô thì code hoạt động tốt nhưng khi em copy và paste 2 dòng trở lên thì báo lỗi, mong các anh chị giúp đỡ thêm giúp em thuộc tính copy paste, và hướng dẫn em ạ. Em cảm ơn ạ.

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim nhom, r As Long, rw As Long, c As Long

nhom = Sheet1.Range("c5:d10000").Value
rw = 0

If Target.Column = 5 And Target.Row > 6 Then
For r = 1 To UBound(nhom)
If nhom(r, 2) = Target.Value Then
rw = r
Exit For
End If
Next r

If rw <> 0 Then
Sheet3.Cells(Target.Row, 4).Value = nhom(r, 1)
Else
MsgBox "Khong Co Ten model  Nay"
End If

End If
End Sub

Ba Tê · 3/1/20

duonghychi đã viết:
Mong các anh chị giúp đỡ ạ.
Em có đoạn code sưu tầm như dưới, khi em nhập dữ liệu từ ô thì code hoạt động tốt nhưng khi em copy và paste 2 dòng trở lên thì báo lỗi, mong các anh chị giúp đỡ thêm giúp em thuộc tính copy paste, và hướng dẫn em ạ. Em cảm ơn ạ.

Mã:

Private Sub Worksheet_Change(ByVal Target As Range) Dim nhom, r As Long, rw As Long, c As Long nhom = Sheet1.Range("c5:d10000").Value rw = 0 If Target.Column = 5 And Target.Row > 6 Then For r = 1 To UBound(nhom) If nhom(r, 2) = Target.Value Then rw = r Exit For End If Next r If rw <> 0 Then Sheet3.Cells(Target.Row, 4).Value = nhom(r, 1) Else MsgBox "Khong Co Ten model Nay" End If End If End Sub

Code này mà Copy Paste một lần hàng trăm ô thì hơi bị "Rùa".

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Nhom(), Cll As Range, r As Long
    Nhom = Sheet1.Range("c5", Sheet1.Range("d10000").End(xlUp)).Value
If Target.Column = 5 And Target.Row > 6 Then
    For Each Cll In Target
        For r = 1 To UBound(Nhom)
            If Nhom(r, 2) = Cll.Value Then
                Cll.Offset(, -1).Value = Nhom(r, 1)
                Exit For
            End If
        Next r
    Next Cll
End If
End Sub

quochr · 3/1/20

Giải thích giúp mình đoạn code này

Mã:

ArrData = Sheet1.Range(Sheet1.Cells(10, 126), Sheet1.Cells(&H100000, 2).End(xlUp)).Value

Mình ko hiểu chỗ này: Sheet1.Cells(&H100000, 2) (dấu & có ý nghĩa gì)

Giúp mình giải thích luôn toàn bộ ý nghĩa câu lệnh này, do ko hiểu chỗ dấu & nên ko biết nó muốn thể hiện lệnh nào

Thanks

batman1 · 3/1/20

quochr đã viết:
Giải thích giúp mình đoạn code này

Mã:

ArrData = Sheet1.Range(Sheet1.Cells(10, 126), Sheet1.Cells(&H100000, 2).End(xlUp)).Value

Mình ko hiểu chỗ này: Sheet1.Cells(&H100000, 2) (dấu & có ý nghĩa gì)

Giúp mình giải thích luôn toàn bộ ý nghĩa câu lệnh này, do ko hiểu chỗ dấu & nên ko biết nó muốn thể hiện lệnh nào

Cảm ơn

Bạn có thể cung cấp (truyền) mỗi một giá trị Long bằng 2 cách: nhập số ở dạng thập phân hoặc ở dạng hex (hệ 16). Vd. số 15 ở dạng hex là 0F. Nhưng nhập 15 thì được còn nhập 0F thì không được. Bạn phải thêm tiền tố là &H (H <- Hex) để chỉ ra đó là số ở dạng hex. Tức trong ví dụ là phải nhập - truyền &H0F.

&H100000 (dạng hex) = 1048576 (thập phân).

Vậy thì

Mã:

ArrData = Sheet1.Range(Sheet1.Cells(10, 126), Sheet1.Cells(&H100000, 2).End(xlUp)).Value

tương đương với

Mã:

ArrData = Sheet1.Range(Sheet1.Cells(10, 126), Sheet1.Cells(1048576, 2).End(xlUp)).Value

Sheet1.Cells(10, 126) là ô ở dòng 10 và cột 126, tức ô ở dòng 10 và cột DV, tức là ô DV10 trong Sheet1.

Sheet1.Cells(1048576, 2).End(xlUp) là ô cuối cùng có dữ liệu ở cột 2 - cột B. Diễn giải là: hãy xuất phát từ ô ở dòng 1048576 và cột 2, tức ô B1048576 (thường thì là ô trống) và đi lên trên (xlUp) cho tới khi gặp ô <> trống thì dừng. Muốn xác định ô cuối cùng có dữ liệu trong một cột nào đó thì ô xuất phát - ô B1048576 trong ví dụ phải rỗng. Thường thì những ô ở những dòng cuối cùng của trang tính là rỗng nên có thể yên tâm.

Lúc này thì

Mã:

ArrData = Sheet1.Range(Sheet1.Cells(10, 126), Sheet1.Cells(&H100000, 2).End(xlUp)).Value

có nghĩa là: lấy vùng dữ liệu (lấy giá trị) xác định bởi DV10 và ô cuối cùng có dữ liệu ở cột B từ Sheet1 vào mảng ArrData
------------
Sheet1.Cells(1048576, 2).End(xlUp) có thể thay bằng Sheet1.Cells(Rows.Count, 2).End(xlUp) hoặc
Sheet1.Range("B" & 1048576).End(xlUp) hoặc Sheet1.Range("B" & Rows.Count).End(xlUp), bởi Rows.Count trong Excel >= 2007 trả về giá trị 1048576 (số dòng trong trang tính)
---------
Bạn có thể định nghĩa hằng số theo 2 cách tương đương như sau:

Const MySecretNumber = 15
Const MySecretNumber = &H0F

quochr · 3/1/20

batman1 đã viết:
Bạn có thể cung cấp (truyền) mỗi một giá trị Long bằng 2 cách: nhập số ở dạng thập phân hoặc ở dạng hex (hệ 16). Vd. số 15 ở dạng hex là 0F. Nhưng nhập 15 thì được còn nhập 0F thì không được. Bạn phải thêm tiền tố là &H (H <- Hex) để chỉ ra đó là số ở dạng hex. Tức trong ví dụ là phải nhập - truyền &H0F.

&H100000 (dạng hex) = 1048576 (thập phân).

Vậy thì

Mã:

ArrData = Sheet1.Range(Sheet1.Cells(10, 126), Sheet1.Cells(&H100000, 2).End(xlUp)).Value

tương đương với

Mã:

ArrData = Sheet1.Range(Sheet1.Cells(10, 126), Sheet1.Cells(1048576, 2).End(xlUp)).Value

Sheet1.Cells(10, 126) là ô ở dòng 10 và cột 126, tức ô ở dòng 10 và cột DV, tức là ô DV10 trong Sheet1.

Sheet1.Cells(1048576, 2).End(xlUp) là ô cuối cùng có dữ liệu ở cột 2 - cột B. Diễn giải là: hãy xuất phát từ ô ở dòng 1048576 và cột 2, tức ô B1048576 (thường thì là ô trống) và đi lên trên (xlUp) cho tới khi gặp ô <> trống thì dừng. Muốn xác định ô cuối cùng có dữ liệu trong một cột nào đó thì ô xuất phát - ô B1048576 trong ví dụ phải rỗng. Thường thì những ô ở những dòng cuối cùng của trang tính là rỗng nên có thể yên tâm.

Lúc này thì

Mã:

ArrData = Sheet1.Range(Sheet1.Cells(10, 126), Sheet1.Cells(&H100000, 2).End(xlUp)).Value

có nghĩa là: lấy vùng dữ liệu (lấy giá trị) xác định bởi DV10 và ô cuối cùng có dữ liệu ở cột B từ Sheet1 vào mảng ArrData
------------
Sheet1.Cells(1048576, 2).End(xlUp) có thể thay bằng Sheet1.Cells(Rows.Count, 2).End(xlUp) hoặc
Sheet1.Range("B" & 1048576).End(xlUp) hoặc Sheet1.Range("B" & Rows.Count).End(xlUp), bởi Rows.Count trong Excel >= 2007 trả về giá trị 1048576 (số dòng trong trang tính)
---------
Bạn có thể định nghĩa hằng số theo 2 cách tương đương như sau:

Const MySecretNumber = 15
Const MySecretNumber = &H0F

Để mình test thử rồi báo bạn kết quả. Thanks bạn

quochr · 3/1/20

batman1 đã viết:
Bạn có thể cung cấp (truyền) mỗi một giá trị Long bằng 2 cách: nhập số ở dạng thập phân hoặc ở dạng hex (hệ 16). Vd. số 15 ở dạng hex là 0F. Nhưng nhập 15 thì được còn nhập 0F thì không được. Bạn phải thêm tiền tố là &H (H <- Hex) để chỉ ra đó là số ở dạng hex. Tức trong ví dụ là phải nhập - truyền &H0F.

&H100000 (dạng hex) = 1048576 (thập phân).

Vậy thì

Mã:

ArrData = Sheet1.Range(Sheet1.Cells(10, 126), Sheet1.Cells(&H100000, 2).End(xlUp)).Value

tương đương với

Mã:

ArrData = Sheet1.Range(Sheet1.Cells(10, 126), Sheet1.Cells(1048576, 2).End(xlUp)).Value

Sheet1.Cells(10, 126) là ô ở dòng 10 và cột 126, tức ô ở dòng 10 và cột DV, tức là ô DV10 trong Sheet1.

Sheet1.Cells(1048576, 2).End(xlUp) là ô cuối cùng có dữ liệu ở cột 2 - cột B. Diễn giải là: hãy xuất phát từ ô ở dòng 1048576 và cột 2, tức ô B1048576 (thường thì là ô trống) và đi lên trên (xlUp) cho tới khi gặp ô <> trống thì dừng. Muốn xác định ô cuối cùng có dữ liệu trong một cột nào đó thì ô xuất phát - ô B1048576 trong ví dụ phải rỗng. Thường thì những ô ở những dòng cuối cùng của trang tính là rỗng nên có thể yên tâm.

Lúc này thì

Mã:

ArrData = Sheet1.Range(Sheet1.Cells(10, 126), Sheet1.Cells(&H100000, 2).End(xlUp)).Value

có nghĩa là: lấy vùng dữ liệu (lấy giá trị) xác định bởi DV10 và ô cuối cùng có dữ liệu ở cột B từ Sheet1 vào mảng ArrData
------------
Sheet1.Cells(1048576, 2).End(xlUp) có thể thay bằng Sheet1.Cells(Rows.Count, 2).End(xlUp) hoặc
Sheet1.Range("B" & 1048576).End(xlUp) hoặc Sheet1.Range("B" & Rows.Count).End(xlUp), bởi Rows.Count trong Excel >= 2007 trả về giá trị 1048576 (số dòng trong trang tính)
---------
Bạn có thể định nghĩa hằng số theo 2 cách tương đương như sau:

Const MySecretNumber = 15
Const MySecretNumber = &H0F

Mình đã làm dc. Thanks ban

duonghychi · 4/1/20

Ba Tê đã viết:
Code này mà Copy Paste một lần hàng trăm ô thì hơi bị "Rùa".

Em cảm ơn ạ!

quochr · 4/1/20

CHo mình hỏi thêm chút về code khi gọi outlook để sent email (mình đang dùng office 2019) thì nó xuất hiện cái box này. CÓ cách nào để nó auto sent mà không phải request không (file đính kèm)

*** Mình đang viết code để sent email auto by outlook

Đây là code mình đã viết

Mã:

'Progame sent email to many people (chuong trinh goi email hang loat cho nhieu nguoi)
Sub sent_email()

'Call app Outlook
Dim OlApp As Outlook.Application
Set OlApp = CreateObject("Outlook.Application")

Dim i, y As Integer

'i la bien cot the hien email nguoi nhan
'y la bien so nguoi nhan email
y = Excel.WorksheetFunction.CountA(ThisWorkbook.Sheets(8).Range("G:G"))

For i = 2 To y
'Open app email
Dim olmail As Outlook.MailItem
Set olmail = OlApp.CreateItem(olMailItem)

Dim body_messenge As String
body_messenge = ThisWorkbook.Sheets(8).Cells(1, 13)
body_messenge = Excel.WorksheetFunction.Substitute(Excel.WorksheetFunction.Substitute(body_messenge, "staff", ThisWorkbook.Sheets(8).Cells(i, 8)), "password", ThisWorkbook.Sheets(8).Cells(i, 9))


'Sent email
olmail.To = ThisWorkbook.Sheets(8).Cells(i, 7)
olmail.Subject = "CTY A GOI PHIEU LUONG THANG ABC"
olmail.BodyFormat = olFormatHTML
olmail.HTMLBody = body_messenge
olmail.Attachments.Add ThisWorkbook.Path & "\Phieuluong Jan-2020\" & ThisWorkbook.Sheets(8).Cells(i, 10)
olmail.Send

Next
End Sub

quochr · 4/1/20

quochr đã viết:

CHo mình hỏi thêm chút về code khi gọi outlook để sent email (mình đang dùng office 2019) thì nó xuất hiện cái box này. CÓ cách nào để nó auto sent mà không phải request không (file đính kèm)

*** Mình đang viết code để sent email auto by outlook

Đây là code mình đã viết

Mã:

'Progame sent email to many people (chuong trinh goi email hang loat cho nhieu nguoi)
Sub sent_email()

'Call app Outlook
Dim OlApp As Outlook.Application
Set OlApp = CreateObject("Outlook.Application")

Dim i, y As Integer

'i la bien cot the hien email nguoi nhan
'y la bien so nguoi nhan email
y = Excel.WorksheetFunction.CountA(ThisWorkbook.Sheets(8).Range("G:G"))

For i = 2 To y
'Open app email
Dim olmail As Outlook.MailItem
Set olmail = OlApp.CreateItem(olMailItem)

Dim body_messenge As String
body_messenge = ThisWorkbook.Sheets(8).Cells(1, 13)
body_messenge = Excel.WorksheetFunction.Substitute(Excel.WorksheetFunction.Substitute(body_messenge, "staff", ThisWorkbook.Sheets(8).Cells(i, 8)), "password", ThisWorkbook.Sheets(8).Cells(i, 9))


'Sent email
olmail.To = ThisWorkbook.Sheets(8).Cells(i, 7)
olmail.Subject = "CTY A GOI PHIEU LUONG THANG ABC"
olmail.BodyFormat = olFormatHTML
olmail.HTMLBody = body_messenge
olmail.Attachments.Add ThisWorkbook.Path & "\Phieuluong Jan-2020\" & ThisWorkbook.Sheets(8).Cells(i, 10)
olmail.Send

Next
End Sub

Mình đã tìm ra nguyên nhân.
Tắt chức năng này trong OUT là sẽ không bị nữa
Sử dụng Programmatic Access cho Outlook. Chọn thẻ File > Options > Trust Center > Trust Center Settings > Thẻ Programmatic Access > Bấm dấu tích vào “Never warn me about suspicious activity (not recommended) rồi bấm OK (Nhớ chạy OUT dưới quyền admin mới chỉnh được chức năng này)

phananhvusv · 4/1/20

Nhờ các anh/chị trên diễn đàn giải đáp giúp em. em có đoạn code dùng Dictionary như sau:

Mã:

Sub dictMadoituong()
Dim dongcuoi As Long
Dim vungchon() As Variant
Dim khoa As String
Dim i As Long
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
With Sheets("DATA")
dongcuoi = .Cells(.Rows.Count, "N").End(xlUp).Row
vungchon = Range("N2:N" & dongcuoi)
For i = 1 To dongcuoi - 1
    khoa = vungchon(i, 1)
    If Not dic.exists(khoa) Then
    dic.Add vungchon(i, 1), 1
    Else
    dic.Item(khoa) = dic.Item(khoa) + 1
    End If
Next i
End With
With Sheets("Sheet1")
Range("a14:a" & dic.Count + 13) = Application.Transpose(dic.keys)
Range("b14:b" & dic.Count + 13) = Application.Transpose(dic.items)
End With
End Sub

Ngay sau chỗ With Sheets("Sheet1"), em muốn dán kết quả từ Dic vào ô A14 và B14 của sheet1, nhưng excel không làm đúng ý em. Em gởi theo file đính kèm.
Nhờ anh/chị chỉ chỗ em làm sai với ạ. Em cám ơn.

batman1 · 4/1/20

phananhvusv đã viết:
Nhờ các anh/chị trên diễn đàn giải đáp giúp em. em có đoạn code dùng Dictionary như sau:

Mã:

Sub dictMadoituong() Dim dongcuoi As Long Dim vungchon() As Variant Dim khoa As String Dim i As Long Dim dic As Object Set dic = CreateObject("scripting.dictionary") With Sheets("DATA") dongcuoi = .Cells(.Rows.Count, "N").End(xlUp).Row vungchon = Range("N2:N" & dongcuoi) For i = 1 To dongcuoi - 1 khoa = vungchon(i, 1) If Not dic.exists(khoa) Then dic.Add vungchon(i, 1), 1 Else dic.Item(khoa) = dic.Item(khoa) + 1 End If Next i End With With Sheets("Sheet1") Range("a14:a" & dic.Count + 13) = Application.Transpose(dic.keys) Range("b14:b" & dic.Count + 13) = Application.Transpose(dic.items) End With End Sub

Ngay sau chỗ With Sheets("Sheet1"), em muốn dán kết quả từ Dic vào ô A14 và B14 của sheet1, nhưng excel không làm đúng ý em. Em gởi theo file đính kèm.
Nhờ anh/chị chỉ chỗ em làm sai với ạ. Em cám ơn.

Thay

Mã:

vungchon = Range("N2:N" & dongcuoi)

bằng

vungchon = .Range("N2:N" & dongcuoi).Value

Nguyên nhân là do khi chạy code thì sheet1 đang hoạt động và code cũ lấy vùng N2:N*** từ sheet1 vào mảng vungchon. Code sau khi sửa thì lấy N2:N*** từ sheet DATA vào mảng vungchon.

phananhvusv · 4/1/20

batman1 đã viết:
Thay

Mã:

vungchon = Range("N2:N" & dongcuoi)

bằng

Nguyên nhân là do khi chạy code thì sheet1 đang hoạt động và code cũ lấy vùng N2:N*** từ sheet1 vào mảng vungchon. Code sau khi sửa thì lấy N2:N*** từ sheet DATA vào mảng vungchon.

Trước khi cho vungchon = range... thì đã có With Sheets("DATA") rồi mà anh? sao nó lại lấy từ sheet1 nhỉ? Chỉ cần thêm sửa .Range...Value thì lại lấy từ Sheets("DATA") nhỉ?

batman1 · 4/1/20

phananhvusv đã viết:
Trước khi cho vungchon = range... thì đã có With Sheets("DATA") rồi mà anh? sao nó lại lấy từ sheet1 nhỉ? Chỉ cần thêm sửa .Range...Value thì lại lấy từ Sheets("DATA") nhỉ?

Bạn có vungchon = Range("N2:N" & dongcuoi) nên RANGE là lấy từ ACTIVESHEET (là Sheet1 do Sheet1 đang hoạt động). Viết như bạn thì vungchon = Range("N2:N" & dongcuoi) chính là vungchon = ActiveSheet.Range("N2:N" & dongcuoi), tức vungchon = Sheet1.Range("N2:N" & dongcuoi) Vì thế phải có dấu . trước Range để lấy từ DATA (do có With Sheets("DATA"))

phananhvusv · 4/1/20

batman1 đã viết:
Bạn có vungchon = Range("N2:N" & dongcuoi) nên RANGE là lấy từ ACTIVESHEET (là Sheet1 do Sheet1 đang hoạt động). Viết như bạn thì vungchon = Range("N2:N" & dongcuoi) chính là vungchon = ActiveSheet.Range("N2:N" & dongcuoi), tức vungchon = Sheet1.Range("N2:N" & dongcuoi) Vì thế phải có dấu . trước Range để lấy từ DATA (do có With Sheets("DATA"))

Em cám ơn bác nhiều. Hèn gì nếu đang ở Sheet DATA mà chạy code thì đúng, còn ở Sheet1 thì sai.
Còn dòng này thì sao bác?
With Sheets("Sheet1")
Range("a14:a" & dic.Count + 13) = Application.Transpose(dic.keys)
Em có cần .Range chỗ này không bác nhỉ?

batman1 · 4/1/20

phananhvusv đã viết:
Em cám ơn bác nhiều. *** gì nếu đang ở Sheet DATA mà chạy code thì đúng, còn ở Sheet1 thì sai.
Còn dòng này thì sao bác?
With Sheets("Sheet1")
Range("a14:a" & dic.Count + 13) = Application.Transpose(dic.keys)
Em có cần .Range chỗ này không bác nhỉ?

Nguyên tắc là thế này:
- nếu muốn luôn luôn truy cập tới activesheet, bất luận ACTIVESHEET là sheet nào, thì không thể dùng dấu . được.
- nếu muốn luôn luôn truy cập tới sheet cụ thể, bất luận nó có là activesheet hay không, thì luôn luôn phải viết tường minh - gọi tên chỉ mặt cụ thể. Vd. Sheet1.Range(...). Hoặc nếu dùng trong cấu trúc With Sheet1 ... End With thì phải dùng dấu . trước Rang(...)

Bạn có thể không dùng dấu . trước range khi có With Sheets("Sheet1"), nhưng chỉ trong trường hợp cụ thể này của bạn - chạy code bằng cách nhấn nút trên sheet1. Một ngày đẹp trời nào đó bạn cần chạy "code kia" khi thực hiện một code khác. Lúc đó "code kia" sẽ được chạy khi có thể activesheet không là sheet1. Lúc đó kết quả sẽ sai. Vì thế người biết lo xa, biết lường trước các tình huống người ta sẽ dùng dấu . trước Range.

Đừng bao giờ để con ma hên xui nó quyết định cách hoạt động của code của mình. Theo nguyên tắc tôi nêu trên thì "ở chỗ đó" bạn muốn truy cập tới sheet cụ thể là sheet1. Vậy hãy dùng dấu . để không một trường hợp nào làm sai lệch ý muốn của mình. Tại sao bỏ dấu . để rồi phụ thuộc vào hên xui, để rồi ăn không ngon ngủ không yên? Đó không là cách hành xử thông minh.

Nếu không dùng dấu . trong With Sheets("Sheet1") thì With Sheets("Sheet1") là vô dụng, vì bạn luôn truy câp tới activesheet. Nếu sheet1 là activesheet thì dĩ nhiên With Sheets("Sheet1") là thừa rồi. Nếu sheet1 không là activesheet thì With Sheets("Sheet1") cũng thừa vì code truy cập tới activesheet chứ không truy cập tới sheet1.

phananhvusv · 5/1/20

batman1 đã viết:
Nếu không dùng dấu . trong With Sheets("Sheet1") thì With Sheets("Sheet1") là vô dụng, vì bạn luôn truy câp tới activesheet. Nếu sheet1 là activesheet thì dĩ nhiên With Sheets("Sheet1") là thừa rồi. Nếu sheet1 không là activesheet thì With Sheets("Sheet1") cũng thừa vì code truy cập tới activesheet chứ không truy cập tới sheet1.

Em đã hiểu. cám ơn bác nhiều ạ. Trước đó em cứ đinh ninh là trong With Sheets đã rõ ràng rồi. Nếu vậy dùng hẳn Sheet1.Range(...) sẽ đơn giản hơn, không cần phải để trong With..End nữa. Em đã thông rồi ạ.

viethoana2 · 17/1/20

'Allowance qty
Select Case (Cells(i, 13).Value)
Case "Voc"
Cells(x + 15, y + resignMonth).Value = Cells(x + 15, y + resignMonth).Value + 1
Sheets("MsTung request").Cells(4, 13 + resignMonth).Value = Sheets("MsTung request").Cells(4, 13 + resignMonth).Value + 1
Case "S.term"
Cells(x + 16, y + resignMonth).Value = Cells(x + 16, y + resignMonth).Value + 1
Sheets("MsTung request").Cells(5, 13 + resignMonth).Value = Sheets("MsTung request").Cells(5, 13 + resignMonth).Value + 1
Case "None"
Cells(x + 17, y + resignMonth).Value = Cells(x + 17, y + resignMonth).Value + 1
Case "Elder3"
Cells(x + 18, y + resignMonth).Value = Cells(x + 18, y + resignMonth).Value + 1
Case "Elder 2"
Cells(x + 19, y + resignMonth).Value = Cells(x + 19, y + resignMonth).Value + 1
Case "Elder 1"
Cells(x + 20, y + resignMonth).Value = Cells(x + 20, y + resignMonth).Value + 1
Case "Skill 4"
Cells(x + 21, y + resignMonth).Value = Cells(x + 21, y + resignMonth).Value + 1
Case "Skill 3"
Cells(x + 22, y + resignMonth).Value = Cells(x + 22, y + resignMonth).Value + 1
Case "Skill 2"
Cells(x + 23, y + resignMonth).Value = Cells(x + 23, y + resignMonth).Value + 1
Case "Skill 1"
Cells(x + 24, y + resignMonth).Value = Cells(x + 24, y + resignMonth).Value + 1
Case "Support 2"
Cells(x + 25, y + resignMonth).Value = Cells(x + 25, y + resignMonth).Value + 1
Case Else
Cells(x + 26, y + resignMonth).Value = Cells(x + 26, y + resignMonth).Value + 1

Cho em hỏi có cách nào để thu gọn các lệnh giống nhau liên tiếp thế này và cải thiện tốc độ chạy của VBA ạ

ppc0312 · 17/1/20

viethoana2 đã viết:
'Allowance qty
Select Case (Cells(i, 13).Value)
Case "Voc"
Cells(x + 15, y + resignMonth).Value = Cells(x + 15, y + resignMonth).Value + 1
Sheets("MsTung request").Cells(4, 13 + resignMonth).Value = Sheets("MsTung request").Cells(4, 13 + resignMonth).Value + 1
Case "S.term"
Cells(x + 16, y + resignMonth).Value = Cells(x + 16, y + resignMonth).Value + 1
Sheets("MsTung request").Cells(5, 13 + resignMonth).Value = Sheets("MsTung request").Cells(5, 13 + resignMonth).Value + 1
Case "None"
Cells(x + 17, y + resignMonth).Value = Cells(x + 17, y + resignMonth).Value + 1
Case "Elder3"
Cells(x + 18, y + resignMonth).Value = Cells(x + 18, y + resignMonth).Value + 1
Case "Elder 2"
Cells(x + 19, y + resignMonth).Value = Cells(x + 19, y + resignMonth).Value + 1
Case "Elder 1"
Cells(x + 20, y + resignMonth).Value = Cells(x + 20, y + resignMonth).Value + 1
Case "Skill 4"
Cells(x + 21, y + resignMonth).Value = Cells(x + 21, y + resignMonth).Value + 1
Case "Skill 3"
Cells(x + 22, y + resignMonth).Value = Cells(x + 22, y + resignMonth).Value + 1
Case "Skill 2"
Cells(x + 23, y + resignMonth).Value = Cells(x + 23, y + resignMonth).Value + 1
Case "Skill 1"
Cells(x + 24, y + resignMonth).Value = Cells(x + 24, y + resignMonth).Value + 1
Case "Support 2"
Cells(x + 25, y + resignMonth).Value = Cells(x + 25, y + resignMonth).Value + 1
Case Else
Cells(x + 26, y + resignMonth).Value = Cells(x + 26, y + resignMonth).Value + 1

Cho em hỏi có cách nào để thu gọn các lệnh giống nhau liên tiếp thế này và cải thiện tốc độ chạy của VBA ạ

Có: dùng With ..., và tìm quay luật các chỉ số để sửa hợp lý, hoặc đổi ARRAY
Vì chỉ có đoạn code ---> nên đoán đại cho trúng

HeSanbi · 17/1/20

viethoana2 đã viết:
'Allowance qty
Select Case (Cells(i, 13).Value)
Case "Voc"
Cells(x + 15, y + resignMonth).Value = Cells(x + 15, y + resignMonth).Value + 1
Sheets("MsTung request").Cells(4, 13 + resignMonth).Value = Sheets("MsTung request").Cells(4, 13 + resignMonth).Value + 1
Case "S.term"
Cells(x + 16, y + resignMonth).Value = Cells(x + 16, y + resignMonth).Value + 1
Sheets("MsTung request").Cells(5, 13 + resignMonth).Value = Sheets("MsTung request").Cells(5, 13 + resignMonth).Value + 1
Case "None"
Cells(x + 17, y + resignMonth).Value = Cells(x + 17, y + resignMonth).Value + 1
Case "Elder3"
Cells(x + 18, y + resignMonth).Value = Cells(x + 18, y + resignMonth).Value + 1
Case "Elder 2"
Cells(x + 19, y + resignMonth).Value = Cells(x + 19, y + resignMonth).Value + 1
Case "Elder 1"
Cells(x + 20, y + resignMonth).Value = Cells(x + 20, y + resignMonth).Value + 1
Case "Skill 4"
Cells(x + 21, y + resignMonth).Value = Cells(x + 21, y + resignMonth).Value + 1
Case "Skill 3"
Cells(x + 22, y + resignMonth).Value = Cells(x + 22, y + resignMonth).Value + 1
Case "Skill 2"
Cells(x + 23, y + resignMonth).Value = Cells(x + 23, y + resignMonth).Value + 1
Case "Skill 1"
Cells(x + 24, y + resignMonth).Value = Cells(x + 24, y + resignMonth).Value + 1
Case "Support 2"
Cells(x + 25, y + resignMonth).Value = Cells(x + 25, y + resignMonth).Value + 1
Case Else
Cells(x + 26, y + resignMonth).Value = Cells(x + 26, y + resignMonth).Value + 1

Cho em hỏi có cách nào để thu gọn các lệnh giống nhau liên tiếp thế này và cải thiện tốc độ chạy của VBA ạ

Vận dụng vòng lặp
Nếu muốn nhanh hơn với dữ liệu nhiều hơn thì mảng phải được sắp xếp, và xử dụng thuật toán tìm kiếm, như Tìm kiếm nhị phân, tìm kiếm hồi quy, ...

PHP:

Dim R&, Arr
Arr = VBA.Array("Voc", "S.term", "...")
For R = 0 to Ubound(Arr)
    If Arr(R) = (Cells(i, 13).Value) Then
       R = R + 15
        Cells(x + R, y + resignMonth).Value = Cells(x + R, y + resignMonth).Value + 1
        If R = 15 Or R = 16 Then
           R = R - 11
            Sheets("MsTung request").Cells(R, 13 + resignMonth).Value = Sheets("MsTung request").Cells(R, 13 + resignMonth).Value + 1
        End If
       Exit For
    End IF
Next

hktanh · 30/1/20

Nhờ các bạn xem giúp mình code này sai ở đâu với, thấy toàn báo lỗi Invalid Next Control Variable Reference

Sub yuop()

Dim i As Integer
Dim j As Integer

Application.EnableEvents = False

For i = 1 To 1000
For j = 1 To 1000

Sheets("Sheet1").Cells(i + 1, j + 1).Value = Sheets("Sheet1").Cells(i, j).Value

Next i
Next j

Application.EnableEvents = True

End Sub

CHAOQUAY · 30/1/20

hktanh đã viết:
Nhờ các bạn xem giúp mình code này sai ở đâu với, thấy toàn báo lỗi Invalid Next Control Variable Reference

Sub yuop()

Dim i As Integer
Dim j As Integer

Application.EnableEvents = False

For i = 1 To 1000
For j = 1 To 1000

Sheets("Sheet1").Cells(i + 1, j + 1).Value = Sheets("Sheet1").Cells(i, j).Value

Next i
Next j

Application.EnableEvents = True

End Sub

Thử sửa như bên dưới xem sao
Next i thành Next j
Next j thành Next i

rinjp727 · 2/2/20

Chào chủ thớt và mọi người.
Hiện em gặp chút thắc mắc, mong mọi người giải đáp cho ạ.
Em sử dùng Userform có 1 Button "Kết quả" và 1 TextBox, Khi nhấn Button thì nó sẽ so sánh 2 ô E"x" và F"x",
Nếu giá trị ô F"x" > giá trị ô E"x" => Điền vào ô G"x" là "Lãi" hiển thị lên TextBox là "Đã đủ chỉ tiêu", còn nếu ko thì sẽ điền vào ô G"x" là "Lỗ" và TextBox là "Chưa đủ chỉ tiêu",
đồng thời gán x = x + 1.
Và nếu ở TextBox là "Đã đủ chỉ tiêu" Thì sẽ bôi màu nền hoặc màu chữ màu Xanh, và nếu "Chưa đủ chỉ tiêu" thì sẽ bôi màu nền hoặc màu chữ màu Đỏ.
Mọi người giúp em đoạn code này với ạ.
Em xin cảm ơn

SA_DQ · 3/2/20

Em sử dùng Userform có 1 Button "Kết quả" và (A) 1 TextBox, Khi nhấn Button thì nó sẽ so sánh 2 ô E"x" và F"x",
Nếu giá trị ô F"x" > giá trị ô E"x" => Điền vào ô G"x" là "Lãi" hiển thị lên TextBox là "Đã đủ chỉ tiêu", còn nếu ko thì sẽ điền vào ô G"x" là "Lỗ" và TextBox là "Chưa đủ chỉ tiêu",
(B) đồng thời gán x = x + 1.
. . . . . . .

Mình thử dịch từ tiếng Việt của bạn sang tiếng Việt phổ thông xem đúng không nha:

(A) Mình cần so dánh các trị cùng dòng trong hai cột 'E' & cột 'F'
Nếu trị tại ô E dòng x (nào đó) hơn trị trong cột F cùng dòng thì . . . .
Còn ngược lại thì . . . .

(B) Tiếp tục so sánh cho đến cuối cột chứa dữ liệu

???

batman1 · 3/2/20

SA_DQ đã viết:
Mình thử dịch từ tiếng Việt của bạn sang tiếng Việt phổ thông xem đúng không nha:
(A) Mình cần so dánh các trị cùng dòng trong hai cột 'E' & cột 'F'
Nếu trị tại ô F dòng x (nào đó) hơn trị trong cột F cùng dòng thì . . . .
Còn ngược lại thì . . . .

Bản dịch sai. Cái này không bao giờ sảy ra.

SA_DQ · 3/2/20

Đúng rồi, mình vô lý quá! (& đã sửa trên bài của mình)
Xin cảm ơn BatMan1 nhiều nha!

batman1 · 3/2/20

SA_DQ đã viết:
Đúng rồi, mình vô lý quá! (& đã sửa trên bài của mình)
...
Nếu trị tại ô E dòng x (nào đó) hơn trị trong cột F cùng dòng thì . . . .

Vẫn sai. Hoặc "Nếu trị tại ô E dòng x (nào đó) hơn HOẶC BẰNG trị trong cột F cùng dòng thì . . . (Lỗ) Còn ngược lại thì . . . (Lãi)", hoặc "Nếu trị tại ô F dòng x (nào đó) HƠN trị trong cột E cùng dòng thì . . . (Lãi) Còn ngược lại thì . . . (Lỗ)"

SA_DQ · 3/2/20

Mình đâu có dịch hoàn toàn nội dung đâu; Dịch theo ý thôi mà.

Chúc các bạn vui vẻ & có tuần làm việc thành công!

chisinhvnn · 15/2/20

Hàm Function Filter2DArray(ByVal SourceArray, ByVal ColIndex As Long, ByVal FindStr As String, ByVal HasTitle As Boolean) của thầy @ndu96081631.
Mình đang bị vướng chỗ khi Dữ liệu tìm kiếm không có trong vùng dữ liệu tìm kiếm thì nó báo lỗi.
Mình sử dụng câu lệnh dưới để bỏ lỗi nhưng không đươc.

Mã:

If Not IsArray(darr) Then MsgBox "Khong co du lieu"

Nhờ diễn đàn giúp đỡ

SA_DQ · 16/2/20

Bạn cần biết mã lỗi là gì (Err & Error()) & dòng lệnh nào (Erl) bị lỗi

HieuCD · 16/2/20

chisinhvnn đã viết:
Hàm Function Filter2DArray(ByVal SourceArray, ByVal ColIndex As Long, ByVal FindStr As String, ByVal HasTitle As Boolean) của thầy @ndu96081631.
Mình đang bị vướng chỗ khi Dữ liệu tìm kiếm không có trong vùng dữ liệu tìm kiếm thì nó báo lỗi.
Mình sử dụng câu lệnh dưới để bỏ lỗi nhưng không đươc.

Mã:

If Not IsArray(darr) Then MsgBox "Khong co du lieu"

Nhờ diễn đàn giúp đỡ

Bức tử sub là xong film

Mã:

If Not IsArray(darr) Then MsgBox "Khong co du lieu": Exit Sub

chisinhvnn · 16/2/20

HieuCD đã viết:
Bức tử sub là xong film

Mã:

If Not IsArray(darr) Then MsgBox "Khong co du lieu": Exit Sub

code trên không ăn nếu khai báo ban đầu kiểu mãng darr (); bỏ () mới có tác dụng. (một bạn trên Fac dienđàn đã giải thích và áp dụng)

tai101044 · 20/2/20

em có code : If Sheets("Raw Customer Data").Range("f1" + i) = "yes" Then
Code này em muốn so sánh 2 ô 2 sheets khác nhau, nhưng báo lỗi!
Anh chị giải thích giúp em được không ạ!

VetMini · 20/2/20

tai101044 đã viết:
em có code : If Sheets("Raw Customer Data").Range("f1" + i) = "yes" Then
Code này em muốn so sánh 2 ô 2 sheets khác nhau, nhưng báo lỗi!
Anh chị giải thích giúp em được không ạ!

Muốn học code thì ít nhất phải biết lấy giấy bút ra ghi lại xem nó báo lỗi gì chứ.
Tôi có thể chỉ ra lỗi ngay tại chỗ. Nhưng làm như vậy là "cơm bón tận miệng". Tôi chỉ muốn giúp bạn cách nấu cơm thôi.

tai101044 · 20/2/20

VetMini đã viết:
Muốn học code thì ít nhất phải biết lấy giấy bút ra ghi lại xem nó báo lỗi gì chứ.
Tôi có thể chỉ ra lỗi ngay tại chỗ. Nhưng làm như vậy là "cơm bón tận miệng". Tôi chỉ muốn giúp bạn cách nấu cơm thôi.

ok bạn! nó báo lỗi " type mismatch" Mình nghĩ nó định dạng 2 ô khác nhau, tạm thời mình chưa fix được!

VetMini · 20/2/20

tai101044 đã viết:
ok bạn! nó báo lỗi " type mismatch" Mình nghĩ nó định dạng 2 ô khác nhau, tạm thời mình chưa fix được!

Tôi vốn không giao thiệp với tiếng Tây bồi.
Lỡ rồi, tôi chỉ làm một lần này thôi.
"Type mismatch" theo nghĩa rộng có nghĩa là trong code có một toán tử hay biểu thức nào đó đã đặt biến không đúng vào kiểu của nó.
Trong trường hợp trước mắt, code của bạn thì nó có toán tử "+" được thực hiện giữa hai vế "f1" và i. Và bị lỗi kiểu.
Tôi không thể biết i kiểu gì. Nhưng "f1" thì chắc chắn là kiểu chuỗi (string). Đối với VBA, toán tử nối chuỗi luôn luôn là "&" chứ không phải "+". Trong VBA, toán tử "+" chỉ dùng được cho kiểu số. VBA không có chuyện hàm chồng toán tử như C++ hay Java.

Túm lại, biểu thức Sheets("Raw Customer Data").Range("f1" + i) phải sửa lại là Sheets("Raw Customer Data").Range("f1" & i)
Với toán tử "&", VBA sẽ hiểu là code muốn nói chuỗi, và sẽ tự động ép kiểu i thành chuỗi để nối vào "f1".
Lưu ý là tôi chỉ mách cho bạn về lỗi "type mismatch". Code của bạn còn sai chỗ khác hay không thì tôi hoàn toàn không thể đoán.

tai101044 · 20/2/20

VetMini đã viết:
Tôi vốn không giao thiệp với tiếng Tây bồi.
Lỡ rồi, tôi chỉ làm một lần này thôi.
"Type mismatch" theo nghĩa rộng có nghĩa là trong code có một toán tử hay biểu thức nào đó đã đặt biến không đúng vào kiểu của nó.
Trong trường hợp trước mắt, code của bạn thì nó có toán tử "+" được thực hiện giữa hai vế "f1" và i. Và bị lỗi kiểu.
Tôi không thể biết i kiểu gì. Nhưng "f1" thì chắc chắn là kiểu chuỗi (string). Đối với VBA, toán tử nối chuỗi luôn luôn là "&" chứ không phải "+". Trong VBA, toán tử "+" chỉ dùng được cho kiểu số. VBA không có chuyện hàm chồng toán tử như C++ hay Java.

Túm lại, biểu thức Sheets("Raw Customer Data").Range("f1" + i) phải sửa lại là Sheets("Raw Customer Data").Range("f1" & i)
Với toán tử "&", VBA sẽ hiểu là code muốn nói chuỗi, và sẽ tự động ép kiểu i thành chuỗi để nối vào "f1".
Lưu ý là tôi chỉ mách cho bạn về lỗi "type mismatch". Code của bạn còn sai chỗ khác hay không thì tôi hoàn toàn không thể đoán.

Cảm ơn bạn!

hungyen2010 · 26/2/20

em làm một hàm như sau giống như hàm INDEX, MATCH nhưng khi gọi hàm code chạy mất 30 phút mới cho kq các bác có cách nào cải thiện tốc độ chạy khi gọi hàm



Public Function tenKH(Rng As Range, dk As Range) As Variant
Dim sArr(), I As Long, Tem As String
sArr = Rng.Value
'Tem = dk.Value
For I = 1 To UBound(sArr)
If sArr(I, 4) = dk.Value Then
tenKH = sArr(I, 3)
Exit For
End If
Next I
End Function

sub để gọi hàm


Sub sms()
Application.ScreenUpdating = False
Dim lastrow_GL As Long, I As Long, lastrow_LN As Long
Dim Rng As Range, table_LN As Range
Dim Mang()
Dim strTmp As String
Dim rln As Long
lastrow_GL = Sheet2.Cells(Sheets2.Rows.Count, "A").End(xlUp).Row
lastrow_LN = Sheet1.Cells(Sheet1.Rows.Count, "d").End(xlUp).Row
lastrow_GL1 = Sheet4.Cells(Sheet4.Rows.Count, "d").End(xlUp).Row
For I = 2 To lastrow_GL
Sheet3.Range("k" & I).Value = tachLAV(Sheet3.Range("X" & I))
Next
Call tongphiHD
Set table_LN = Sheet1.Range("d2:ag" & lastrow_LN)

Dim Arr As Variant


For rgl = 2 To lastrow_GL1
       
       
        [B]Sheet4.Range("c" & rgl) = tenKH(Sheet1.Range("a2:ag" & lastrow_LN), Sheet4.Range("$d" & rgl))
         [/B]
    Next
  
    Application.ScreenUpdating = True
   
End Sub

heyhey1994 · 3/3/20

Chào cả nhà, em có dòng code này chọn file access rồi xuất sang excel mà ko biết sai ở đâu mà nó lúc chạy lúc ko. Cái này em dùng record macro rồi chỉnh sửa lại. Nhờ mọi người giúp đỡ ạ.

Sub TAIDULIEUTINHTOAN()
Dim Filt As String
Dim FilterIndex As Integer
Dim Title As String
Dim Filename As String
Filt = "Microsoft Access Database(*.mdb),*.mdb," & _
"All Files (*.*),*.*"
FilterIndex = 1
Title = "Load Data"
Filename = Application.GetOpenFilename(FileFilter:=Filt, FilterIndex:=FilterIndex, Title:=Title)
If Filename = "False" Then
MsgBox "NO FILE."
Exit Sub
End If

Sheets("Beam Forces").Activate
Sheets("Beam Forces").Columns("A:Z").Select
Selection.ClearContents
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
"OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=" & Filename & ";Mode=Share Deny Write" _
, _
";Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB

atabase Password="""";Jet OLEDB:Engine " _
, _
"Type=5;Jet OLEDB

atabase Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New " _
, _
"Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB

on't Copy Locale on Comp" _
, _
"act=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False" _
), Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdTable
.CommandText = Array("Beam Forces")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = Filename
.Refresh BackgroundQuery:=False
End With
End sub

Quick_man · 18/3/20

Em mới tập tành VBA nên có cái này hỏi ngu chút. Dòng addindent và indentLevel có liên quan gì nhau không? Sao e thay đổi giá trị 2 dòng đó thấy độc lập nhau. Tiện thể cho e hỏi cách thụt đầu hàng cho 1 ô excel bằng VBA (chỉ hàng đầu thôi). Cảm ơn mọi người nhiều.

Mã:

            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlBottom
            .WrapText = True
            .Orientation = 0
            .AddIndent = True
            .IndentLevel = 2
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = True

hvn8006 · 2/4/20

Nhờ các anh chị trong diễn đàn xử lý giúp em Code về thời gian này ạ:
Function gio(So As Variant)
If Trim(So) = "" Or So = 0 Then
Else
gio = "gi" & ChrW(7901) & " phút "
mGio = Hour(So)
mPhut = Minute(So)
gio = mGio & " gi" & ChrW(7901) & " " & mPhut & " phút"
End If
End Function

Trong trường hợp phút chẵn ( 15h00) thì hàm này trả về kết quả là : 15 giờ 0 phút.

Anh chị có thể hướng dẫn em xử lý thành 15 giờ 00 phút được không ạ.

Trân trọng cảm ơn

snow25 · 3/4/20

hvn8006 đã viết:
Nhờ các anh chị trong diễn đàn xử lý giúp em Code về thời gian này ạ:
Function gio(So As Variant)
If Trim(So) = "" Or So = 0 Then
Else
gio = "gi" & ChrW(7901) & " phút "
mGio = Hour(So)
mPhut = Minute(So)
gio = mGio & " gi" & ChrW(7901) & " " & mPhut & " phút"
End If
End Function

Trong trường hợp phút chẵn ( 15h00) thì hàm này trả về kết quả là : 15 giờ 0 phút.
View attachment 234583

Anh chị có thể hướng dẫn em xử lý thành 15 giờ 00 phút được không ạ.

Trân trọng cảm ơn

Bạn thêm Format vào chỗ cuối nhé.Mình không xem code.Bạn thử nhé.

Mã:

Function gio(So As Variant)
If Trim(So) = "" Or So = 0 Then
Else
gio = "gi" & ChrW(7901) & " phút "
mGio = Hour(So)
mPhut = Minute(So)
gio = mGio & " gi" & ChrW(7901) & " " & Format(mPhut, "00") & " phút"
End If
End Function

Phuocam · 3/4/20

hvn8006 đã viết:
mGio = Hour(So)

Gặp trường hợp 24: 00 hàm trả về 0 giờ 0 phút

Thử code này:

PHP:

Function GioPhut(So As Double) As String
Dim mGio As String, mPhut As String
If So < 0 Then Exit Function
    mGio = Int(Round(So * 24, 10)) & " gi" & ChrW(7901)
    mPhut = Format(Minute(So), "00") & " phút"
GioPhut = mGio & " " & mPhut
End Function

trandungch · 8/4/20

em viết cái code tách sheet của nhiều file trong thu mục mà bị lỗi, nhờ các bác xem giùm với ạ
Dim xPath As String
Dim sh As Worksheet

chonFile = Application.GetOpenFilename(Title:="chon cac file can tach", filefilter:="excel File (*.xls*), *.xls*", MultiSelect:=True)
Application.ScreenUpdating = False
Application.DisplayAlerts = False

For i = 1 To UBound(chonFile)
Set openfile = Workbooks.Open(chonFile(i))
xPath = Application.ActiveWorkbook.Path
'tach sheet
For Each sh In Worksheets
sh.Copy

ActiveWorkbook.SaveAs Filename:=xPath & "\" & ws.Name & "_" & wb.Name
ActiveWorkbook.Close
Next

Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

hieunguyen1996 · 9/4/20

Xin cả nhà giúp em ca này với. Chẳng là em có sưu tầm được 1 code trên diễn đàn có thể replace 1 đoạn text trong nhiều file excel một lúc. File này có thể hoạt động với cả Tiếng Việt vì lấy giá trị của một ô nên không bị lỗi font. Bây giờ em muốn sửa lại bộ code này để replace cho các file word. Cả nhà giúp em với ạ. Em cảm ơn trước

Mã:

Sub ReplaceInFolder()
    Dim strPath As String
    Dim strFile As String
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim strFind As String
    Dim strReplace As String
    strFind = Application.InputBox("Enter text to find", Type:=2)
    If strFind = "" Then
        MsgBox "No find text specified!", vbExclamation
        Exit Sub
    End If
    strReplace = Application.InputBox("Enter replacement text", Type:=2)
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            strPath = .SelectedItems(1)
        Else
            MsgBox "No folder selected!", vbExclamation
            Exit Sub
        End If
    End With
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If
    Application.ScreenUpdating = False
    strFile = Dir(strPath & "*.xls*")
    Do While strFile <> ""
        If strFile <> ThisWorkbook.Name Then
            Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)
            For Each wsh In wbk.Worksheets
                    wsh.Cells.Replace What:=strFind, Replacement:=strReplace, LookAt:=xlPart, _
                            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            Next wsh
            wbk.Close SaveChanges:=True
        End If
        strFile = Dir
    Loop
    Application.ScreenUpdating = True
MsgBox "done"
End Sub

VetMini · 10/4/20

hieunguyen1996 đã viết:
Xin các đại cao thủ giúp em ca này với. ...
...hoạt động với cả Tiếng Việt ...

Biết "đại cao thủ" trong tiếng Việt là gì không?

hieunguyen1996 · 10/4/20

VetMini đã viết:
Biết "đại cao thủ" trong tiếng Việt là gì không?

em không biết từ này có ý nghĩa bậy bạ gì không @@, nếu có gì mạo phạm cho em xin lỗi

hl88 · 18/4/20

xin giúp đỡ, có bác nào biết escape character của hàm Format không ạ. Em muốn lấy giờ từ datepicker ra kết quả như sau 16gio-10phut-55giay

Mã:

Format(DTpicker1.Value, "HHgio-mm-phut-ss-giay")

dùng code trên nó sẽ ra như sau 16gio-10p16ut-55giay

batman1 · 18/4/20

hl88 đã viết:
xin giúp đỡ, có bác nào biết escape character của hàm Format không ạ. Em muốn lấy giờ từ datepicker ra kết quả như sau 16gio-10phut-55giay

Mã:

Format(DTpicker1.Value, "HHgio-mm-phut-ss-giay")

dùng code trên nó sẽ ra như sau 16gio-10p16ut-55giay

Không đúng. Nếu chuỗi như trên thì kết quả phải là 16gio-10-p16ut-55-gia109

Chuỗi phải là "HHgio-mmp\hut-ssgia\y" hoặc "HH-gio-mm-p\hut-ss-gia\y", tùy theo ý muốn.

Vấn đề là các ký tự như "h", "y" , "m", "d" v...v có ý nghĩa đặc biệt trong chuỗi định dạng. Nếu cần dùng các ký tự đó với ý nghĩa bình thường của chúng thì phải thêm vào trước chúng ký tự "\"

hl88 · 18/4/20

batman1 đã viết:
Không đúng. Nếu chuỗi như trên thì kết quả phải là 16gio-10-p16ut-55-gia109

Chuỗi phải là "HHgio-mmp\hut-ssgia\y" hoặc "HH-gio-mm-p\hut-ss-gia\y", tùy theo ý muốn.

Vấn đề là các ký tự như "h", "y" , "m", "d" v...v có ý nghĩa đặc biệt trong chuỗi định dạng. Nếu cần dùng các ký tự đó với ý nghĩa bình thường của chúng thì phải thêm vào trước chúng ký tự "\"

cám ơn bác, đã chạy thành công :thumbs:

Trước khi hỏi đã sử dụng """ và Char(72) của ký tự h đều không được.

phuong197 · 21/4/20

Em đang bị lỗi này mà không biết vì sao nhờ anh chỉ giùm
em có bảng sau:
A
1 1
2 2
3 3

em viết code như sau nhưng khi chạy báo lỗi hàng "if rng = Nothing"

Sub test()
Dim rng As Range
Dim i As Integer

For i = 1 To 3
If Range("A" & i) = 4 Then
Set rng = Range("A" & i)
End If

If rng = Nothing Then 'bao loi o hang nay
MsgBox "no number 4"

Else
MsgBox "number 4 in row" & rng.Row
End If

Next i

End Sub

SA_DQ · 21/4/20

Thay vì báo lỗi, bạn thay lại thế này:
If Rng Is Nothing Then

sherlaby · 21/4/20

Xin chào cả nhà.
Em là newbie tập tành viết VBA.
Hiện đang gặp 1 trục trặc kỳ cục là file em viết trên win10 64bit chạy hoàn toàn bình thường.
Khi mang sang máy win7 32bit thì lần đầu tiên chạy được bình thường.

Cả 2 máy đều đang dùng office 2010.
Những đoạn code trong file e đều tham khảo trên các web hướng dẫn.
E có đính kèm file, nhờ cả nhà mổ xẻ fix lỗi giúp e.

Mục đích của macro là khi nhấp đúp vào 1 ô trống của cột A thì sẽ hiển thị 1 userform để sreach dữ liệu.
Sau khi chọn dữ liệu rồi thi bấm getdata để chép dòng dữ liệu đó ra

Trong lần đầu chạy thử thì ok, sau khi log off chạy lại thi khi bấm getdata sẽ bị lỗi và chỉ lỗi ở win 32bit.
Win 64 vẫn chạy bình thường.

Problem signature:
Problem Event Name: BEX
Application Name: EXCEL.EXE
Application Version: 14.0.4734.1000
Application Timestamp: 4b58fbb3
Fault Module Name: unknown
Fault Module Version: 0.0.0.0
Fault Module Timestamp: 00000000
Exception Offset: 001fdfff
Exception Code: c0000005
Exception Data: 00000008
OS Version: 6.1.7601.2.1.0.256.1
Locale ID: 1033
Additional information about the problem:
LCID: 1033
skulcid: 1033

Thank cả nhà.

tueyennhi · 24/4/20

Em dùng Code sau để so sánh hai sheet dữ liệu với nhau mà khi chạy máy bị đơ quá. Trước dữ liệu so sánh ít thì nhanh. Bây giờ dữ liệu lên đến gần 3500 dòng và 257 cột. Anh chị có cách nào khác hoặc tinh chỉnh lại code của em để tốc độ nhanh hơn được không?

Mã:

Option Explicit
Option Compare Text
Public Sub SosanhbangDic()
    Dim Dic As Object, ID As String, Tem As String
    Dim R As Long, i As Long, j As Long, k As Long
    Dim Source(), Result(1 To 10000, 1 To 8)
    With Application
         .ScreenUpdating = False
         .Calculation = xlCalculationManual
    End With
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheets("BP")
        Source = .Range("B4", .Range("B65000").End(xlUp)).Resize(, 257).Value
        For i = 5 To UBound(Source, 1)
            ID = Source(i, 1)
            If Len(ID) > 0 Then
                For j = 10 To UBound(Source, 2)
                    Tem = Source(i, 1) & "-" & Source(1, j)
                    Dic.Add Tem, Source(i, j) 'Gan key la ID-Ngay_Dulieucong, Item la Dulieucong
                Next j
            End If
        Next i
    End With
    With Sheets("HR")
        Source = .Range("B4", .Range("B65000").End(xlUp)).Resize(, 257).Value
        For i = 5 To UBound(Source, 1)
            For j = 10 To UBound(Source, 2)
                Tem = Source(i, 1) & "-" & Source(1, j)
                If Dic.Exists(Tem) Then  'Neu khong ton tai key la ID-Ngay_Dulieucong
                    If Source(i, j) <> Dic.Item(Tem) Then
                        k = k + 1
                        Result(k, 1) = Source(i, 1) 'ID
                        Result(k, 2) = Source(1, j) 'Cot
                        Result(k, 3) = Source(2, j) 'Ngay check
                        Result(k, 4) = Day(Source(2, j)) 'Ngay
                        Result(k, 5) = Source(4, j) 'Noi dung check
                        Result(k, 6) = Source(i, j)
                        Result(k, 7) = Dic.Item(Tem)
                        Result(k, 8) = Source(4, j)
                    End If
                    Dic.Remove Tem
                End If
            Next j
        Next i
    End With
    Sheets("Report").Range("B5").CurrentRegion.Offset(2, 0).ClearContents
    Sheets("Report").Range("B5").Resize(UBound(Result, 1), 8) = Result
    If UBound(Dic.Keys, 1) > 0 Then Sheets("Report").Range("J2").Resize(1, UBound(Dic.Keys)) = Dic.Keys
    Set Dic = Nothing
    With Application
         .ScreenUpdating = True
         .Calculation = xlCalculationAutomatic
    End With
End Sub

HieuCD · 24/4/20

tueyennhi đã viết:

Em dùng Code sau để so sánh hai sheet dữ liệu với nhau mà khi chạy máy bị đơ quá. Trước dữ liệu so sánh ít thì nhanh. Bây giờ dữ liệu lên đến gần 3500 dòng và 257 cột. Anh chị có cách nào khác hoặc tinh chỉnh lại code của em để tốc độ nhanh hơn được không?

Mã:

Option Explicit
Option Compare Text
Public Sub SosanhbangDic()
    Dim Dic As Object, ID As String, Tem As String
    Dim R As Long, i As Long, j As Long, k As Long
    Dim Source(), Result(1 To 10000, 1 To 8)
    With Application
         .ScreenUpdating = False
         .Calculation = xlCalculationManual
    End With
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheets("BP")
        Source = .Range("B4", .Range("B65000").End(xlUp)).Resize(, 257).Value
        For i = 5 To UBound(Source, 1)
            ID = Source(i, 1)
            If Len(ID) > 0 Then
                For j = 10 To UBound(Source, 2)
                    Tem = Source(i, 1) & "-" & Source(1, j)
                    Dic.Add Tem, Source(i, j) 'Gan key la ID-Ngay_Dulieucong, Item la Dulieucong
                Next j
            End If
        Next i
    End With
    With Sheets("HR")
        Source = .Range("B4", .Range("B65000").End(xlUp)).Resize(, 257).Value
        For i = 5 To UBound(Source, 1)
            For j = 10 To UBound(Source, 2)
                Tem = Source(i, 1) & "-" & Source(1, j)
                If Dic.Exists(Tem) Then  'Neu khong ton tai key la ID-Ngay_Dulieucong
                    If Source(i, j) <> Dic.Item(Tem) Then
                        k = k + 1
                        Result(k, 1) = Source(i, 1) 'ID
                        Result(k, 2) = Source(1, j) 'Cot
                        Result(k, 3) = Source(2, j) 'Ngay check
                        Result(k, 4) = Day(Source(2, j)) 'Ngay
                        Result(k, 5) = Source(4, j) 'Noi dung check
                        Result(k, 6) = Source(i, j)
                        Result(k, 7) = Dic.Item(Tem)
                        Result(k, 8) = Source(4, j)
                    End If
                    Dic.Remove Tem
                End If
            Next j
        Next i
    End With
    Sheets("Report").Range("B5").CurrentRegion.Offset(2, 0).ClearContents
    Sheets("Report").Range("B5").Resize(UBound(Result, 1), 8) = Result
    If UBound(Dic.Keys, 1) > 0 Then Sheets("Report").Range("J2").Resize(1, UBound(Dic.Keys)) = Dic.Keys
    Set Dic = Nothing
    With Application
         .ScreenUpdating = True
         .Calculation = xlCalculationAutomatic
    End With
End Sub

Tìm cách bỏ lệnh: Dic.Remove Tem

tueyennhi · 24/4/20

HieuCD đã viết:
Tìm cách bỏ lệnh: Dic.Remove Tem

Em xóa dòng lệnh ấy đi rồi vẫn không ăn thua anh ạ.

CHAOQUAY · 24/4/20

tueyennhi đã viết:

Em dùng Code sau để so sánh hai sheet dữ liệu với nhau mà khi chạy máy bị đơ quá. Trước dữ liệu so sánh ít thì nhanh. Bây giờ dữ liệu lên đến gần 3500 dòng và 257 cột. Anh chị có cách nào khác hoặc tinh chỉnh lại code của em để tốc độ nhanh hơn được không?

Mã:

Option Explicit
Option Compare Text
Public Sub SosanhbangDic()
    Dim Dic As Object, ID As String, Tem As String
    Dim R As Long, i As Long, j As Long, k As Long
    Dim Source(), Result(1 To 10000, 1 To 8)
    With Application
         .ScreenUpdating = False
         .Calculation = xlCalculationManual
    End With
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheets("BP")
        Source = .Range("B4", .Range("B65000").End(xlUp)).Resize(, 257).Value
        For i = 5 To UBound(Source, 1)
            ID = Source(i, 1)
            If Len(ID) > 0 Then
                For j = 10 To UBound(Source, 2)
                    Tem = Source(i, 1) & "-" & Source(1, j)
                    Dic.Add Tem, Source(i, j) 'Gan key la ID-Ngay_Dulieucong, Item la Dulieucong
                Next j
            End If
        Next i
    End With
    With Sheets("HR")
        Source = .Range("B4", .Range("B65000").End(xlUp)).Resize(, 257).Value
        For i = 5 To UBound(Source, 1)
            For j = 10 To UBound(Source, 2)
                Tem = Source(i, 1) & "-" & Source(1, j)
                If Dic.Exists(Tem) Then  'Neu khong ton tai key la ID-Ngay_Dulieucong
                    If Source(i, j) <> Dic.Item(Tem) Then
                        k = k + 1
                        Result(k, 1) = Source(i, 1) 'ID
                        Result(k, 2) = Source(1, j) 'Cot
                        Result(k, 3) = Source(2, j) 'Ngay check
                        Result(k, 4) = Day(Source(2, j)) 'Ngay
                        Result(k, 5) = Source(4, j) 'Noi dung check
                        Result(k, 6) = Source(i, j)
                        Result(k, 7) = Dic.Item(Tem)
                        Result(k, 8) = Source(4, j)
                    End If
                    Dic.Remove Tem
                End If
            Next j
        Next i
    End With
    Sheets("Report").Range("B5").CurrentRegion.Offset(2, 0).ClearContents
    Sheets("Report").Range("B5").Resize(UBound(Result, 1), 8) = Result
    If UBound(Dic.Keys, 1) > 0 Then Sheets("Report").Range("J2").Resize(1, UBound(Dic.Keys)) = Dic.Keys
    Set Dic = Nothing
    With Application
         .ScreenUpdating = True
         .Calculation = xlCalculationAutomatic
    End With
End Sub

Bạn thử cách tạo Dic với key= source(i,1), item là 1 mảng chứa dòng dữ liệu xem sao

tueyennhi · 24/4/20

CHAOQUAY đã viết:
Bạn thử cách tạo Dic với key= source(i,1), item là 1 mảng chứa dòng dữ liệu xem sao

Mình cũng tính gán item là cả mảng dữ liệu. Để thử xem sao. Sợ rằng sau đó dùng vòng lặp so sánh thì cũng vất.
Mà mình mới chỉ biết cách gán mảng thủ công như này.
Array(Source(1, 1),Source(1, 2), ...,Source(1, 257) ). Bạn có cách gán nào tốt hơn không?

CHAOQUAY · 24/4/20

tueyennhi đã viết:
Mình cũng tính gán item là cả mảng dữ liệu. Để thử xem sao. Sợ rằng sau đó dùng vòng lặp so sánh thì cũng vất.

Nếu dữ liệu của cột 1 & dữ liệu dòng 1 là 2 loại khác nhau thì sau khi nạp các key là source(i,1), bạn tiếp tục nạp thêm các key là source(1,j) với item là chỉ số cột --> quá trình tra cứu sẽ không phải dùng vòng lặp

tueyennhi · 24/4/20

CHAOQUAY đã viết:
Nếu dữ liệu của cột 1 & dữ liệu dòng 1 là 2 loại khác nhau thì sau khi nạp các key là source(i,1), bạn tiếp tục nạp thêm các key là source(1,j) với item là chỉ số cột --> quá trình tra cứu sẽ không phải dùng vòng lặp

nạp thêm các key là source(1,j)? source(1,j) này là số liệu có thể giống nhau như vậy mình đâu add nó thành key được nhỉ. Hay mình chưa hiểu đúng ý bạn?

Em đính kèm file mọi người xem giúp em nhé.

CHAOQUAY · 24/4/20

tueyennhi đã viết:
nạp thêm các key là source(1,j)? source(1,j) này là số liệu có thể giống nhau như vậy mình đâu add nó thành key được nhỉ. Hay mình chưa hiểu đúng ý bạn?

Em đính kèm file mọi người xem giúp em nhé.

source(1,j) có phải là = B4:ED4

tueyennhi · 24/4/20

CHAOQUAY đã viết:
source(1,j) có phải là = B4:ED4

Đúng rồi bạn. Mình nhầm, cái này luôn luôn khác nhau. Nhưng sang dòng tiếp theo thì vẫn xét chung cái dòng này mà.
source(i,1) luôn luôn khác nhau, nhưng cái source(1,j) thì là dùng chung cho toàn bộ source(i,1)

CHAOQUAY · 24/4/20

tueyennhi đã viết:
Đúng rồi bạn. Mình nhầm, cái này luôn luôn khác nhau. Nhưng sang dòng tiếp theo thì vẫn xét chung cái dòng này mà.
source(i,1) luôn luôn khác nhau, nhưng cái source(1,j) thì là dùng chung cho toàn bộ source(i,1)

Bạn thử code dưới xem sao

Mã:

Option Compare Text
Public Sub SosanhbangDic()
    Dim Dic As Object, ID As String, Tem As String
    Dim R As Long, i As Long, j As Long, k As Long
    Dim Source1(), Result(1 To 10000, 1 To 8)
    
    Dim Source0()
    Dim x, z, t
    
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheets("BP")
        Source0 = .Range("B4", .Range("B65000").End(xlUp)).Resize(, 134).Value
        For i = 5 To UBound(Source0, 1)
            ID = Source0(i, 1)
            If Len(ID) > 0 Then
                For j = 10 To 133
                    'Tem = Source0(i, 1) & "-" & Source0(1, j)
                    'Dic.Add Tem, Source0(i, j) 'Gan key la ID-Ngay_Dulieucong, Item la Dulieucong
                    
                    Dic.Add Source0(i, 1), i
                    Dic.Add Source0(1, j), j
                Next j
            End If
        Next i
    End With
    With Sheets("HR")
        Source1 = .Range("B4", .Range("B65000").End(xlUp)).Resize(, 134).Value
        For i = 5 To UBound(Source1, 1)
            For j = 10 To 133
                'Tem = Source1(i, 1) & "-" & Source1(1, j)
                'If Dic.exists(Tem) Then  'Neu khong ton tai key la ID-Ngay_Dulieucong
                If Dic.exists(Source1(i, 1)) And Dic.exists(Source1(1, j)) Then
                    x = Dic.Item(Source1(i, 1))
                    z = Dic.Item(Source1(1, j))
                    
                    'If Source1(i, j) <> Dic.Item(Tem) Then
                    If Source1(i, j) <> Source0(x, z) Then
                        k = k + 1
                        Result(k, 1) = Source1(i, 1) 'ID
                        Result(k, 2) = Source1(1, j) 'Cot
                        Result(k, 3) = Source1(2, j) 'Ngay check
                        Result(k, 4) = Day(Source1(2, j)) 'Ngay
                        Result(k, 5) = Source1(4, j) 'Noi dung check
                        Result(k, 6) = Source1(i, j)
                        
                        'Result(k, 7) = Dic.Item(Tem)
                        Result(k, 7) = Source0(x, z)
                        
                        Result(k, 8) = Source1(4, j)
                    End If
                    'Dic.Remove Tem
                End If
            Next j
        Next i
    End With
    Sheets("Report").Range("B5").CurrentRegion.Offset(2, 0).ClearContents
    Sheets("Report").Range("B5").Resize(UBound(Result, 1), 8) = Result
    If UBound(Dic.Keys, 1) > 0 Then Sheets("Report").Range("J2").Resize(1, UBound(Dic.Keys)) = Dic.Keys
    Set Dic = Nothing
End Sub

HieuCD · 24/4/20

CHAOQUAY đã viết:

Bạn thử code dưới xem sao

Mã:

Option Compare Text
Public Sub SosanhbangDic()
    Dim Dic As Object, ID As String, Tem As String
    Dim R As Long, i As Long, j As Long, k As Long
    Dim Source1(), Result(1 To 10000, 1 To 8)
  
    Dim Source0()
    Dim x, z, t
  
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheets("BP")
        Source0 = .Range("B4", .Range("B65000").End(xlUp)).Resize(, 134).Value
        For i = 5 To UBound(Source0, 1)
            ID = Source0(i, 1)
            If Len(ID) > 0 Then
                For j = 10 To 133
                    'Tem = Source0(i, 1) & "-" & Source0(1, j)
                    'Dic.Add Tem, Source0(i, j) 'Gan key la ID-Ngay_Dulieucong, Item la Dulieucong
                  
                    Dic.Add Source0(i, 1), i
                    Dic.Add Source0(1, j), j
                Next j
            End If
        Next i
    End With
    With Sheets("HR")
        Source1 = .Range("B4", .Range("B65000").End(xlUp)).Resize(, 134).Value
        For i = 5 To UBound(Source1, 1)
            For j = 10 To 133
                'Tem = Source1(i, 1) & "-" & Source1(1, j)
                'If Dic.exists(Tem) Then  'Neu khong ton tai key la ID-Ngay_Dulieucong
                If Dic.exists(Source1(i, 1)) And Dic.exists(Source1(1, j)) Then
                    x = Dic.Item(Source1(i, 1))
                    z = Dic.Item(Source1(1, j))
                  
                    'If Source1(i, j) <> Dic.Item(Tem) Then
                    If Source1(i, j) <> Source0(x, z) Then
                        k = k + 1
                        Result(k, 1) = Source1(i, 1) 'ID
                        Result(k, 2) = Source1(1, j) 'Cot
                        Result(k, 3) = Source1(2, j) 'Ngay check
                        Result(k, 4) = Day(Source1(2, j)) 'Ngay
                        Result(k, 5) = Source1(4, j) 'Noi dung check
                        Result(k, 6) = Source1(i, j)
                      
                        'Result(k, 7) = Dic.Item(Tem)
                        Result(k, 7) = Source0(x, z)
                      
                        Result(k, 8) = Source1(4, j)
                    End If
                    'Dic.Remove Tem
                End If
            Next j
        Next i
    End With
    Sheets("Report").Range("B5").CurrentRegion.Offset(2, 0).ClearContents
    Sheets("Report").Range("B5").Resize(UBound(Result, 1), 8) = Result
    If UBound(Dic.Keys, 1) > 0 Then Sheets("Report").Range("J2").Resize(1, UBound(Dic.Keys)) = Dic.Keys
    Set Dic = Nothing
End Sub

Cột theo thứ tự, không cần add cột
Có thể thứ tự dòng giống nhau, không cần Dic

tueyennhi · 24/4/20

CHAOQUAY đã viết:

Bạn thử code dưới xem sao

Mã:

Option Compare Text
Public Sub SosanhbangDic()
    Dim Dic As Object, ID As String, Tem As String
    Dim R As Long, i As Long, j As Long, k As Long
    Dim Source1(), Result(1 To 10000, 1 To 8)
  
    Dim Source0()
    Dim x, z, t
  
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheets("BP")
        Source0 = .Range("B4", .Range("B65000").End(xlUp)).Resize(, 134).Value
        For i = 5 To UBound(Source0, 1)
            ID = Source0(i, 1)
            If Len(ID) > 0 Then
                For j = 10 To 133
                    'Tem = Source0(i, 1) & "-" & Source0(1, j)
                    'Dic.Add Tem, Source0(i, j) 'Gan key la ID-Ngay_Dulieucong, Item la Dulieucong
                  
                    Dic.Add Source0(i, 1), i
                    Dic.Add Source0(1, j), j
                Next j
            End If
        Next i
    End With
    With Sheets("HR")
        Source1 = .Range("B4", .Range("B65000").End(xlUp)).Resize(, 134).Value
        For i = 5 To UBound(Source1, 1)
            For j = 10 To 133
                'Tem = Source1(i, 1) & "-" & Source1(1, j)
                'If Dic.exists(Tem) Then  'Neu khong ton tai key la ID-Ngay_Dulieucong
                If Dic.exists(Source1(i, 1)) And Dic.exists(Source1(1, j)) Then
                    x = Dic.Item(Source1(i, 1))
                    z = Dic.Item(Source1(1, j))
                  
                    'If Source1(i, j) <> Dic.Item(Tem) Then
                    If Source1(i, j) <> Source0(x, z) Then
                        k = k + 1
                        Result(k, 1) = Source1(i, 1) 'ID
                        Result(k, 2) = Source1(1, j) 'Cot
                        Result(k, 3) = Source1(2, j) 'Ngay check
                        Result(k, 4) = Day(Source1(2, j)) 'Ngay
                        Result(k, 5) = Source1(4, j) 'Noi dung check
                        Result(k, 6) = Source1(i, j)
                      
                        'Result(k, 7) = Dic.Item(Tem)
                        Result(k, 7) = Source0(x, z)
                      
                        Result(k, 8) = Source1(4, j)
                    End If
                    'Dic.Remove Tem
                End If
            Next j
        Next i
    End With
    Sheets("Report").Range("B5").CurrentRegion.Offset(2, 0).ClearContents
    Sheets("Report").Range("B5").Resize(UBound(Result, 1), 8) = Result
    If UBound(Dic.Keys, 1) > 0 Then Sheets("Report").Range("J2").Resize(1, UBound(Dic.Keys)) = Dic.Keys
    Set Dic = Nothing
End Sub

Bình bổ sung thêm đoạn này có đúng không nhỉ

Mã:

         If Not Dic.exists(Source0(i, 1)) Then
                        Dic.Add Source0(i, 1), i
                    End If
                    If Not Dic.exists(Source0(1, j)) Then
                        Dic.Add Source0(1, j), j
                    End If

Vì mình thấy nó báo lỗi.
Cảm ơn bạn, code mới xử lý rất nhanh

Chuyên đề giải đáp những thắc mắc về code VBA (12 người xem)

Người dùng đang xem chủ đề này

Thành viên thường trực

Thành viên hoạt động

Thành viên chính thức

File đính kèm

Thành viên chính thức

Thành viên tích cực

Thành viên gạo cội

Thành viên tích cực

File đính kèm

Thành viên gạo cội

Thành viên gạo cội

Thành viên gạo cội

Thành viên tích cực

Thành viên mới

File đính kèm

Thành viên mới

Thành viên gạo cội

Thành viên mới

File đính kèm

❆❆❆❆❆❆❆❆❆❆❆❆

Thành viên mới

File đính kèm

❆❆❆❆❆❆❆❆❆❆❆❆

Thành viên mới

File đính kèm

Thành viên gắn bó

Thành viên thường trực

Thành viên gắn bó

Thành viên thường trực

Thành viên gắn bó

Thành viên thường trực

Thành viên gắn bó

Thành viên thường trực

Thành viên gắn bó

Đang đi tìm hòn đá

Thành viên thường trực

Thành viên gắn bó

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên gắn bó

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên gắn bó

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Đang đi tìm hòn đá

Thành viên mới

File đính kèm

Cạo Rồi Khỏi Gội

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên mới

File đính kèm

Thành viên mới

Thành viên chính thức

File đính kèm

Thành viên gạo cội

Thành viên chính thức

Thành viên gạo cội

Thành viên chính thức

Thành viên gạo cội

Thành viên chính thức

Thành viên mới

whom?

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên bị đình chỉ hoạt động

Thành viên gắn bó

Thành viên mới

/(hông là gì!

Thành viên gạo cội

/(hông là gì!

Thành viên gạo cội

/(hông là gì!

Thành viên tiêu biểu

/(hông là gì!

Chuyên gia GPE