Đố vui về VBA!

anhtuan1066 · 30/12/07

Nhằm cũng cố kiến thức về VBA cho các bạn mới bắt đầu và cả những bạn đang ứng dụng mà chưa hiểu nhiều về nó, tôi mở topic này với mong mõi qua những câu hỏi vui, các bạn sẽ nhận định lại sự hiểu biết cũa mình... (Kễ cã chính tôi cũng đang tập tành nên có rất nhiều cái chưa biết)
Mong rằng topic sẽ mang đến cho các bạn những khám phá thú vị với những cái tưỡng chừng như đã biết
Mong nhận dc bài viết về câu đố cũa các cao thủ! Còn các bạn mới thì đừng ngại khi đưa ra ý kiến cũa mình.. Có sai có sữa sẽ hoàn thiện!
Tôi xin mỡ màn trước bằng 1 câu hỏi đơn giãn
ANH TUẤN

CÂU HỎI 1: Tại sao biến K ko hoạt động?
Tôi muốn khi nhấn vào 1 button thì cell A1 sẽ tăng lên 1 đơn vị... Tôi đã làm như sau:
-Tạo 1 Command Button (nút nhấn thuộc thanh Control Toolbox), click phải chuột lên nút nhấn, chọn View code, rồi gõ vào đoạn code sau:

PHP:

Private Sub CommandButton1_Click()
   K = K + 1
   Range("A1").Value = K
End Sub

Ban đầu K chưa có gì, xem như =0, nhấn nút lần thứ nhất thì K dc tăng thêm 1, vậy K hiện tại sẽ bằng 1, và gán K vào cell A1 thì đương nhiên A1 sẽ =1... Nhấn nút lần 2, K lại dc tăng thêm 1 nên hiện tại K sẽ =2 và cell A1 cũng sẽ =2... vân vân.. từ đó diễn tiến tiếp...
Hi.. hi.. Điều này nghe qua có vẽ rất hợp lý, ấy thế mà khi nhấn nút nó chỉ hoạt động dc duy nhất 1 lần (A1 = 1) rồi thôi ko nhút nhít nữa...
Các bạn có thể giãi thích tại sao lại như thế ko? Tại sao những lần nhấn nút sau đó K lại ko tăng thêm tí nào (vì thực tế A1 vẫn cứ = 1 hoài) ?
ANH TUẤN

hungpecc1 · 29/8/13

dhn46 đã viết:

Mã:

Sub AddCode()
    On Error Resume Next
    Dim WS As Worksheet, strCode As String, CoName As String, Ind As Long, currLine As Long
    Set WS = ActiveWorkbook.Worksheets.Add
        WS.Name = "ANH TUAN"
    Ind = ThisWorkbook.VBProject.VBComponents.Count
    strCode = _
            "Private Sub Worksheet_SelectionChange(ByVal Target As Range) " & vbCr & _
                " MsgBox ""Code ne""" & vbCr & _
            "End Sub"
    CoName = ThisWorkbook.VBProject.VBComponents.Item(Ind).Properties("Codename")
    With ThisWorkbook.VBProject.VBComponents(CoName).CodeModule
        currLine = .CountOfLines
        .InsertLines currLine + 1, strCode
    End With
End Sub

Mình test code của bạn sao vẫn không thấy được nhỉ? <--- mình cũng không hiểu ?
anh Ndu có nói :
"- Sau khi chạy code (mà các bạn viết) xong thì sự kiện Worksheet_SelectionChange lập tức có tác dụng"

Mình hiểu là khi vừa add xong sheets thì sẽ có luôn 1 hộp thoại msgbox "code ne " hiện ra
code của bạn mình thử chạy trong VBA và run marco đều không thấy hiện ra???

Hôm qua mình cũng có viết 1 đoạn code (nhưng vẫn chưa đạt yêu cầu như mình hiểu !) thôi thì đã mất công viết thì cũng post lên đây luôn:

Mã:

Sub add_code_to_NewSheet()
Dim CodeLines As Long
   Sheets.Add
   With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
        CodeLines = .CountOfLines + 1
        .InsertLines CodeLines, _
            "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" & Chr(13) & _
            "     msgbox ""Code nè"" " & Chr(13) & _
            "End Sub"
    End With
    ActiveSheet.Name = "ANH_TUAN"
End Sub

huuthang_bd · 29/8/13

huuthang_bd đã viết:
Em cũng làm được rồi nè. Không mở cửa sổ VBE nhé. Để mai post.

Chắc bây giờ post được rồi. Em làm vầy.

PHP:

Sub Test()
Dim VBC As Object, Ws As Worksheet
Set Ws = Sheets.Add
Ws.Name = "ANH TUAN"
Set VBC = ThisWorkbook.VBProject.VBComponents
VBC(Ws.CodeName).CodeModule.InsertLines 9, "Private Sub Worksheet_SelectionChange(ByVal Target As Range):MsgBox ""Code nè"":End Sub"
End Sub

huuthang_bd · 29/8/13

hungpecc1 đã viết:
Mình test code của bạn sao vẫn không thấy được nhỉ? <--- mình cũng không hiểu ?
anh Ndu có nói :
"- Sau khi chạy code (mà các bạn viết) xong thì sự kiện Worksheet_SelectionChange lập tức có tác dụng"

Mình hiểu là khi vừa add xong sheets thì sẽ có luôn 1 hộp thoại msgbox "code ne " hiện ra
code của bạn mình thử chạy trong VBA và run marco đều không thấy hiện ra???

Hôm qua mình cũng có viết 1 đoạn code (nhưng vẫn chưa đạt yêu càu !) thôi thì đã mất công viết thì cũng post lên đây luôn:

Mã:

Sub add_code_to_NewSheet() Dim CodeLines As Long Sheets.Add With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule CodeLines = .CountOfLines + 1 .InsertLines CodeLines, _ "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" & Chr(13) & _ " msgbox ""Code nè"" " & Chr(13) & _ "End Sub" End With ActiveSheet.Name = "ANH_TUAN" End Sub

Sự kiện Worksheet_SelectionChange lập tức có tác dụng không có nghĩa là sẽ xuất hiện hộp thoại thông báo ngay sau khi chạy code chính đâu bạn, bạn phải thao tác để sự kiện SelectionChange xảy ra (tức là thay đổi vùng chọn) thì mới xuất hiện hộp thoại chứ.

Ngay từ đầu trong câu đố anh ndu đã có nói đến vấn đề khi add một sheet mới thì codename của sheet đó là chuỗi rỗng nên sẽ bị lỗi nếu đóng cửa sổ VBE khi chạy code và code của bạn bị lỗi này, ít nhất là trên Excel 2007.

anhtuan1066 · 29/8/13

huuthang_bd đã viết:
Chắc bây giờ post được rồi. Em làm vầy.

PHP:

Sub Test() Dim VBC As Object, Ws As Worksheet Set Ws = Sheets.Add Ws.Name = "ANH TUAN" Set VBC = ThisWorkbook.VBProject.VBComponents VBC(Ws.CodeName).CodeModule.InsertLines 9, "Private Sub Worksheet_SelectionChange(ByVal Target As Range):MsgBox ""Code nè"":End Sub" End Sub

Đây chính là mấu chốt đề
Có động tác Set VBComponents thì code sẽ nhận biết được codeName ngay lập tức
Chúng ta có thể thí nghiệm để chứng mình

Mã:

Sub Test()
  Dim VBC As Object, Ws As Worksheet
  Set Ws = Sheets.Add
  Ws.Name = "ANH TUAN"
[COLOR=#ff0000]  MsgBox Ws.CodeName

[/COLOR]  Set VBC = ThisWorkbook.VBProject.VBComponents

[COLOR=#ff0000]  MsgBox Ws.CodeName
[/COLOR]  VBC(Ws.CodeName).CodeModule.InsertLines 9, "Private Sub Worksheet_SelectionChange(ByVal Target As Range):MsgBox ""Code nè"":End Sub"
End Sub

MsgBox đầu sẽ cho kết quả rổng, MsgBox thứ 2 sẽ cho kết quả đúng

thanhlanh · 29/8/13

Hi hi cái khoản Set VBComponents này mình vẫn đang dùng để add nhiều Sub một lượt, mà sao không vận dụng vào câu đố này nhỉ!
-------------

Kiểu add code trên còn có thể add một hoặc nhiều dòng (có giới hạn) vào trang code có sẵn, sub có sẵn. Nếu thủ tục ngắn thì có thể Add code kiểu này (nguyên Sub).

Mã:

Sub Test()    Dim VBC As Object, Ws As Worksheet, strCode
    Set Ws = Sheets.Add
    Ws.Name = "ANH TUAN"
    strCode = _
    "Private Sub Worksheet_SelectionChange(ByVal Target As Range) " & vbCr & _
            " MsgBox ""Code ne""" & vbCr & _
              "End Sub"
    Set VBC = ThisWorkbook.VBProject.VBComponents
    VBC(Ws.CodeName).CodeModule.AddFromString strCode
End Sub

Lúc này ta không quan tâm đến có hay không Option Explicit hoặc các khai báo dạng Public, các hàm API có sẵn hay không.

ndu96081631 · 29/8/13

thanhlanh đã viết:
Lúc này ta không quan tâm đến có hay không Option Explicit hoặc các khai báo dạng Public, các hàm API có sẵn hay không.

Dùng AddFromString là đúng rồi nhưng cái chổ màu đỏ sẽ không bao giờ xảy ra đâu anh ---> Ta tạo 1 Sheet mới cơ mà

thanhlanh · 29/8/13

ndu96081631 đã viết:
Dùng AddFromString là đúng rồi nhưng cái chổ màu đỏ sẽ không bao giờ xảy ra đâu anh ---> Ta tạo 1 Sheet mới cơ mà

Không, ý mình nói trong trường hợp tổng quát mà, ví dụ thêm Sub vào một CodeModule có sẵn.

ndu96081631 · 29/8/13

thanhlanh đã viết:
Không, ý mình nói trong trường hợp tổng quát mà, ví dụ thêm Sub vào một CodeModule có sẵn.

Đây lại là trường hợp khác nữa à nha! Khi ấy anh phải thêm công đoạn xóa code phòng trường hợp buồn tay chạy Sub 2 lần để tránh việc Sub trùng với Sub

thanhlanh · 29/8/13

ndu96081631 đã viết:
Đây lại là trường hợp khác nữa à nha! Khi ấy anh phải thêm công đoạn xóa code phòng trường hợp buồn tay chạy Sub 2 lần để tránh việc Sub trùng với Sub

Tất nhiên rồi, nhưng nói hết dài lắm

Theo mình, đơn giản nhất là dùng Instr, ví dụ:

Mã:

        With ActiveWorkbook.VBProject.VBComponents("Tên module").CodeModule
            If InStr(.Lines(1, .CountOfLines), "Tên sub") = 0 Then
                  .AddFromString [COLOR=#000000][I]strCode[/I][/COLOR]
            Else
                  ' Xoa Sub
                  ' Them Sub
            End If
        End With

Mình đưa một đoạn code lên cho các bạn (mới học VBA như mình) tham khảo:

Mã:

[COLOR=#000080][FONT=Courier New]Sub ListProcedures()
[/FONT][/COLOR]        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim LineNum As Long
        Dim NumLines As Long
        Dim WS As Worksheet
        Dim Rng As Range
        Dim ProcName As String
        Dim ProcKind As VBIDE.vbext_ProcKind
        
        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents("Module1")
        Set CodeMod = VBComp.CodeModule
        
        Set WS = ActiveWorkbook.Worksheets("Sheet1")
        Set Rng = WS.Range("A1")
        With CodeMod
            LineNum = .CountOfDeclarationLines + 1
            Do Until LineNum >= .CountOfLines
                ProcName = .ProcOfLine(LineNum, ProcKind)
                Rng.Value = ProcName
                Rng(1, 2).Value = ProcKindString(ProcKind)
                LineNum = .ProcStartLine(ProcName, ProcKind) + _
                        .ProcCountLines(ProcName, ProcKind) + 1
                Set Rng = Rng(2, 1)
            Loop
        End With

    End Sub
    
    
    Function ProcKindString(ProcKind As VBIDE.vbext_ProcKind) As String
        Select Case ProcKind
            Case vbext_pk_Get
                ProcKindString = "Property Get"
            Case vbext_pk_Let
                ProcKindString = "Property Let"
            Case vbext_pk_Set
                ProcKindString = "Property Set"
            Case vbext_pk_Proc
                ProcKindString = "Sub Or Function"
            Case Else
                ProcKindString = "Unknown Type: " & CStr(ProcKind)
        End Select
 [COLOR=#000080][FONT=Courier New]    End Function[/FONT][/COLOR]

Nguồn: http://www.cpearson.com/excel/vbe.aspx
Khi sử dụng, vận dụng, xào xáo lưu ý ActiveWorkbook hay ThisWorkbook

huuthang_bd · 29/8/13

thanhlanh đã viết:

Tất nhiên rồi, nhưng nói hết dài lắm

Theo mình, đơn giản nhất là dùng Instr, ví dụ:

Mã:

        With ActiveWorkbook.VBProject.VBComponents("Tên module").CodeModule
            If InStr(.Lines(1, .CountOfLines), "Tên sub") = 0 Then
                  .AddFromString ("Tên sub")
            Else
                  ' Xoa Sub
                  ' Them Sub
            End If
        End With

Mình đưa một đoạn code lên cho các bạn (mới học VBA như mình) tham khảo:

Mã:

[COLOR=#000080][FONT=Courier New]Sub ListProcedures()
[/FONT][/COLOR]        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim LineNum As Long
        Dim NumLines As Long
        Dim WS As Worksheet
        Dim Rng As Range
        Dim ProcName As String
        Dim ProcKind As VBIDE.vbext_ProcKind
        
        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents("Module1")
        Set CodeMod = VBComp.CodeModule
        
        Set WS = ActiveWorkbook.Worksheets("Sheet1")
        Set Rng = WS.Range("A1")
        With CodeMod
            LineNum = .CountOfDeclarationLines + 1
            Do Until LineNum >= .CountOfLines
                ProcName = .ProcOfLine(LineNum, ProcKind)
                Rng.Value = ProcName
                Rng(1, 2).Value = ProcKindString(ProcKind)
                LineNum = .ProcStartLine(ProcName, ProcKind) + _
                        .ProcCountLines(ProcName, ProcKind) + 1
                Set Rng = Rng(2, 1)
            Loop
        End With

    End Sub
    
    
    Function ProcKindString(ProcKind As VBIDE.vbext_ProcKind) As String
        Select Case ProcKind
            Case vbext_pk_Get
                ProcKindString = "Property Get"
            Case vbext_pk_Let
                ProcKindString = "Property Let"
            Case vbext_pk_Set
                ProcKindString = "Property Set"
            Case vbext_pk_Proc
                ProcKindString = "Sub Or Function"
            Case Else
                ProcKindString = "Unknown Type: " & CStr(ProcKind)
        End Select
 [COLOR=#000080][FONT=Courier New]    End Function[/FONT][/COLOR]

Nguồn: http://www.cpearson.com/excel/vbe.aspx
Khi sử dụng, vận dụng, xào xáo lưu ý ActiveWorkbook hay ThisWorkbook

Dùng hàm Instr để kiểm tra tuy đơn giản nhưng tìm ẩn nhiều rủi ro kết quả kiểm tra có thể không đúng. Vì nếu thủ tục cần kiểm tra chưa có nhưng chỉ cần một từ khóa, tên biến,... trong code trùng hoặc chứa chuỗi tên sub cần kiểm tra thì kết quả vẫn là đã có.

Em nghĩ kiểm tra một sub có tồn tại trong một Module nào đó hay không chỉ cần hàm đơn giản như thế này:

PHP:

Function CheckExistSub(SubName As String, VBC As Object) As Boolean
On Error Resume Next
CheckExistSub = VBC.CodeModule.ProcBodyLine(SubName, 0) > 0
End Function

Và đây là hai sub dùng để kiểm tra.

PHP:

Sub Test1()
MsgBox CheckExistSub("Test1", ThisWorkbook.VBProject.VBComponents("Module1"))
End Sub

PHP:

Sub Test2()
MsgBox CheckExistSub("Test3", ThisWorkbook.VBProject.VBComponents("Module1"))
End Sub

Copy cả 3 đoạn code trên vào Module1 rồi chạy lần lượt Test1 và Test2 để thử.

thanhlanh · 29/8/13

huuthang_bd đã viết:
Dùng hàm Instr để kiểm tra tuy đơn giản nhưng tìm ẩn nhiều rủi ro kết quả kiểm tra có thể không đúng. Vì nếu thủ tục cần kiểm tra chưa có nhưng chỉ cần một từ khóa, tên biến,... trong code trùng hoặc chứa chuỗi tên sub cần kiểm tra thì kết quả vẫn là đã có.

Em nghĩ kiểm tra một sub có tồn tại trong một Module nào đó hay không chỉ cần hàm đơn giản như thế này:

PHP:

Function CheckExistSub(SubName As String, VBC As Object) As Boolean On Error Resume Next CheckExistSub = VBC.CodeModule.ProcBodyLine(SubName, 0) > 0 End Function

Và đây là hai sub dùng để kiểm tra.

PHP:

Sub Test1() MsgBox CheckExistSub("Test1", ThisWorkbook.VBProject.VBComponents("Module1")) End Sub

PHP:

Sub Test2() MsgBox CheckExistSub("Test3", ThisWorkbook.VBProject.VBComponents("Module1")) End Sub

Copy cả 3 đoạn code trên vào Module1 rồi chạy lần lượt Test1 và Test2 để thử.

Cách của Thắng rất hay nhưng mình dị ứng với lỗi nên cũng ngại dùng.

Nếu tìm một hay vài từ, ví dụ tìm "Sub ABC()" khi dùng Instr dễ bị sai trong trường hợp Sub đó bị bỏ đi (đặt sau dấu ' )

Nhưng khi tìm nguyên Sub thì sẽ không bao giờ sai, với điều kiện là code cần tìm (biến StrCode) phải y chang code cũ đã có.

Mã:

If InStr(.Lines(1, .CountOfLines), StrCode) = 0 Then

...

anhtuan1066 · 29/8/13

Chèn code sự kiện vào 1 file đang đóng

Cũng liên quan đến vấn đề chèn code, xin đố câu nữa:
- Tôi có 2 file: A.xls và B.xls cùng nằm trên 1 thư mục
- File B.xls chỉ có 1 sheet duy nhất tên là Sheet1 (Sheet Name và CodeName trùng tên nhau)
- File B.xls chỉ chứa 1 ClassModule duy nhất (code gì không biết)... ngoài ra không có bất cứ code trên sheet hay Module nào cả
- File B.xls có đặt password VBA (đương nhiên ta biết đó là password gì)
---------------------------
Nhiệm vụ của ta là:
- Viết code trong file A.xls để chèn sự kiện Change vào Cell A1 của Sheet1 trong file B.xls
- Sau khi code chạy thành công, mở file B.xls lên, gõ gì đó vào cell A1 thì lập tức StatusBar sẽ hiện ra những gì ta vừa gõ
---------------------------
Cũng hơi khoai nha!

huuthang_bd · 29/8/13

anhtuan1066 đã viết:
Cũng liên quan đến vấn đề chèn code, xin đố câu nữa:
- Tôi có 2 file: A.xls và B.xls cùng nằm trên 1 thư mục
- File B.xls chỉ có 1 sheet duy nhất tên là Sheet1 (Sheet Name và CodeName trùng tên nhau)
- File B.xls chỉ chứa 1 ClassModule duy nhất (code gì không biết)... ngoài ra không có bất cứ code trên sheet hay Module nào cả
- File B.xls có đặt password VBA (đương nhiên ta biết đó là password gì)
---------------------------
Nhiệm vụ của ta là:
- Viết code trong file A.xls để chèn sự kiện Change vào Cell A1 của Sheet1 trong file B.xls
- Sau khi code chạy thành công, mở file B.xls lên, gõ gì đó vào cell A1 thì lập tức StatusBar sẽ hiện ra những gì ta vừa gõ
---------------------------
Cũng hơi khoai nha!

Cái này hình như hết "vui" rồi. Chuyển qua giai đoạn đau đầu.

anhtuan1066 · 29/8/13

huuthang_bd đã viết:
Cái này hình như hết "vui" rồi. Chuyển qua giai đoạn đau đầu.

Nhưng sẽ vui nếu bạn viết rằng đáp án nó thật đơn giản
(Tôi đố vui nên chẳng khi nào code dài quá 30 dòng)
Nhớ ĐỌC KỸ câu hỏi nha (nhiều khi bị "lừa" mà không biết)

huuthang_bd · 30/8/13

anhtuan1066 đã viết:
Nhưng sẽ vui nếu bạn viết rằng đáp án nó thật đơn giản
(Tôi đố vui nên chẳng khi nào code dài quá 30 dòng)
Nhớ ĐỌC KỸ câu hỏi nha (nhiều khi bị "lừa" mà không biết)

Có thể cách này không đúng với đáp án của anh vì em bỏ qua khá nhiều dữ kiện của câu đố. Tuy nhiên, code vẫn thực hiện được mục đích cuối cùng.

anhtuan1066 · 30/8/13

huuthang_bd đã viết:
Có thể cách này không đúng với đáp án của anh vì em bỏ qua khá nhiều dữ kiện của câu đố. Tuy nhiên, code vẫn thực hiện được mục đích cuối cùng.

File B.xls phải có khả năng chạy độc lập chứ Thắng
Tức là: Chạy code từ file A.xls xong, đóng file A.xls lại, mở file B.xls lên thì lập tức sự kiện Change sẽ có tác dụng (tại cell A1)
---------------
Mình nói thêm về câu đố trên: Các bạn chèn code theo bất cứ kiểu gì (không nhất thiết là Worksheet_Change) miễn sao file B.xls nó có khả năng thực hiện được yêu cầu hiện StatusBar khi gõ vào cell A1 là được
--------------
Vậy: Điều các bạn cần suy nghĩ ở đây là LÀM CÁCH NÀO CÓ THỂ CHÈN CODE MÀ VƯỢT QUA ĐƯỢC PASSWORD VBA

dhn46 · 31/8/13

anhtuan1066 đã viết:
................................................
--------------
Vậy: Điều các bạn cần suy nghĩ ở đây là LÀM CÁCH NÀO CÓ THỂ CHÈN CODE MÀ VƯỢT QUA ĐƯỢC PASSWORD VBA

Có phải thầy đang nhắc tới thủ thuật như bài #7 trong Topic này không nhỉ?
http://www.giaiphapexcel.com/forum/...ế-bằng-1-đoạn-code-mới-mà-không-mở-file

ndu96081631 · 31/8/13

dhn46 đã viết:
Có phải thầy đang nhắc tới thủ thuật như bài #7 trong Topic này không nhỉ?
http://www.giaiphapexcel.com/forum/...ế-bằng-1-đoạn-code-mới-mà-không-mở-file

Thì cứ thử xem! Ai mà biết đâu chứ
Ẹc... Ẹc...

SA_DQ · 5/9/13

Mình có bài này, xin nhờ các bạn giải giúp

Ờ cột trang tính S1 mình có bảng số liệu về ngày tháng như sau:

B |
8/20/2013|
9/9/2013|
9/26/2013|
10/7/2013|
10/15/2013|
|

Ở cột [C] trang tính thứ 2 (S2) mình cũng có bảng số liệu như sau:

C |
8/16/2013|
8/23/2013
8/30/2013
9/06/2013|
9/13/2013
9/20/2013|
9/27/2013
10/04/2013|
10/11/2013|
|

Các bạn giúp tôi macro để cột [B:C] trang S1 có số liệu như sau

B | C
8/20/2013|8/16/2013
|8/23/2013
|8/30/2013
9/9/2013|9/6/2013
9/26/2013|9/13/2013
|9/20/2013
|9/27/2013
10/7/2013|10/4/2013|
10/15/2013|10/11/2013
|

Rất cám ơn!

VetMini · 5/9/13

Dùng giải thuật sắp mảng so le.

Mã:

Sub t()

' xac dinh vung du lieu dau vao. Luc lam that, thay doi cho nay
Const RANGEB = "B1:B5"
Const RANGEC = "C1:C9"

Dim b1 As Variant, c1 As Variant ' array chua du lieu dau vao

b1 = Application.Transpose(Range(RANGEB).Value)
c1 = Application.Transpose(Range(RANGEC).Value)

Range(RANGEB).Clear ' xoa du lieu, de ghi du lieu moi
Range(RANGEC).Clear

Dim szb As Integer, szc As Integer ' do lon cac mang du lieu dau vao
szb = UBound(b1): szc = UBound(c1)

Dim b2 As Variant, c2 As Variant ' array chua du lieu dau ra
ReDim b2(1 To szb + szc)
ReDim c2(1 To szb + szc)

Dim ib1 As Integer, ib2 As Integer, ic1 As Integer, ic2 As Integer ' cac chi so mang
Dim bVc As Integer ' so sanh B va C tuong ung

ib1 = 1: ic1 = 1: i2 = 0

' vong lap doc du lieu dau vao va ghi dau ra
While ib1 <= szb And ic1 <= szc
i2 = i2 + 1
bVc = 100 * Year(b1(ib1)) + Month(b1(ib1)) - 100 * Year(c1(ic1)) - Month(c1(ic1))
' thang cua B bang hoac lon hon C, ghi cot C
If bVc >= 0 Then
    c2(i2) = Format(c1(ic1), "yyyy-mm-dd")
    ic1 = ic1 + 1
End If
' thang cua B bang hoac nho hon C, ghi cot B
If bVc <= 0 Then
    b2(i2) = Format(b1(ib1), "yyyy-mm-dd")
    ib1 = ib1 + 1
End If
Wend

' chep lai
Range("B1").Resize(i2, 1).Value2 = Application.Transpose(b2)
Range("C1").Resize(i2, 1).Value2 = Application.Transpose(c2)

End Sub

code này tôi có hơi lười biếng format kết quả nên sẽ có mấy dữ liệu ra là con số. Nếu bạn format columns lại theo dạng date sẽ thấy kết quả. Nếu siêng thì tự chỉnh sửa phần code format.

Đố vui về VBA!

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

Thành viên gắn bó

Chuyên gia GPE

Chuyên gia GPE

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

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

Huyền thoại GPE

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

Huyền thoại GPE

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

Chuyên gia GPE

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

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

Chuyên gia GPE

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

Chuyên gia GPE

File đính kèm

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

Hướng tới tương lai

Huyền thoại GPE

/(hông là gì!

Ăn cùng góc phố