Hỏi nhanh - Đáp nhanh về macro (dành cho các thành viên mới học lập trình)

Liên hệ QC

tuananhya2

Thành viên mới
Tham gia
18/8/12
Bài viết
8
Được thích
0
Co ai chỉ dùm cách tạo pass marco với
 
Hỏi về câu lệnh chỉ chạy trong một Sheet nào đó trong một Workbook?

Xin chào Thầy Cô và Anh Chị!
Em đang vướng mắc một vấn đề này mong mọi người giúp đỡ ạ.
ví dụ em muốn khi di chuyển đến sheet2 thì ô A1 của sheet 2 này ra kết quả là 1.
Còn khi di chuyển đến các sheet khác (ngoài sheet2) thì ô A1 của Sheet2 sẽ cho kết quả là 0.
Vấn đề tưởng chừng đơn giản quá nhưng chưa thể làm được với cấu lệnh:
Mã:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
...
End Sub
 
Upvote 0
Xin chào Thầy Cô và Anh Chị!
Em đang vướng mắc một vấn đề này mong mọi người giúp đỡ ạ.
ví dụ em muốn khi di chuyển đến sheet2 thì ô A1 của sheet 2 này ra kết quả là 1.
Còn khi di chuyển đến các sheet khác (ngoài sheet2) thì ô A1 của Sheet2 sẽ cho kết quả là 0.
Vấn đề tưởng chừng đơn giản quá nhưng chưa thể làm được với cấu lệnh:
Mã:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
...
End Sub
Thì chèn lệnh vào
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveSheet.Name = "Sheet2" Then
[A1] = 1
Else
[A1] = 0
End If
End Sub
 
Upvote 0
Xin chào Thầy Cô và Anh Chị!
Em đang vướng mắc một vấn đề này mong mọi người giúp đỡ ạ.
ví dụ em muốn khi di chuyển đến sheet2 thì ô A1 của sheet 2 này ra kết quả là 1.
Còn khi di chuyển đến các sheet khác (ngoài sheet2) thì ô A1 của Sheet2 sẽ cho kết quả là 0.
Vấn đề tưởng chừng đơn giản quá nhưng chưa thể làm được với cấu lệnh:
Mã:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
...
End Sub
Mã:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.CodeName = "Sheet2" Then
        Sheet2.[A1] = 1
    Else
        Sheet2.[A1] = 0
    End If
End Sub
Mục đích của bạn là làm gì vậy?
ban quanghai1969 xem lại thử chỗ nì
Thì chèn lệnh vào
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveSheet.Name = "Sheet2" Then
[A1] = 1
Else
[A1] = 0 '<= Nếu ActiveSheet <> Sheet2 ví dụ là Sheet1 thì chỗ nì Sheet1.[A1] = 0 sao?

End If
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Mã:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If [COLOR=#0000cd][B]Sh.CodeName = "Sheet2"[/B][/COLOR] Then
        Sheet2.[A1] = 1
    Else
        Sheet2.[A1] = 0
    End If
End Sub
Mục đích của bạn là làm gì vậy
ban quanghai1969 xem lại bị sai nhé

Thì ra là vậy! Cảm ơn bạn rất nhiều!!
À mục đích của mình cũng để chỉ dựa vào con số này để If và Else cho các đoạn code mà thôi ^^
 
Upvote 0
Mã:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.CodeName = "Sheet2" Then
        Sheet2.[A1] = 1
    Else
        Sheet2.[A1] = 0
    End If
End Sub
Mục đích của bạn là làm gì vậy
ban quanghai1969 xem lại bị sai nhé
Hức hức tưởng đâu là........ nên code không cần file, ai dè trật lất
 
Upvote 0
e đang vướng ở vấn đề liên kết đến sheet khác ... ví dụ
Ban đầu e tạo nút ẩn hết tất cả các sheet trên sheet Menu
Sau đó tạo nút ấn D500 ở sheet Menu khi nhấn vào thì sẽ hiện đồng thời 2 sheet D510 và D520, nút ấn D600 ở sheet Menu thì khi nhấn vào sẽ hiện đồng thời 2 sheet D610 và D620, tương tự các nút ấn khác sẽ chuyển đến 2 sheet khác ...
Nhưng
em tìm trên GPE và cả google cũng chỉ có macro liên kết từ sheet này đến 1 sheet khác
Sub LinktoSheet()
With ActiveSheet
With Sheets(.Shapes(Application.Caller).AlternativeText)
.Visible = True: .Select
End With
.Visible = 2
End With
End Sub
Mong thầy cô và ac nào biết giúp e, e cảm ơn !!!
 
Upvote 0
Hỏi về một cái gì đó xảy ra theo điều kiện selection trong một vùng dữ liệu?

Chào các bạn!Mình đang vướng mắc một sự cố mong các bạn giúp đỡ.

ví dụ với đoạn code này thì OK.
Mã:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = [COLOR=#008000][B]Range("C2")[/B][/COLOR].Address Then Range("A1").Value = 1
    If Target.Address = [COLOR=#008000][B]Range("E2")[/B][/COLOR].Address Then Range("A1").Value = 0
End Sub

Nhưng mình muốn mở rộng hơn 1 chút nữa là chuyển từ 1 Cell thành 1 vùng thì thế này:
Mã:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = [COLOR=#ff0000][B]Range("C2:C10")[/B][/COLOR].Address Then Range("A1").Value = 1
    If Target.Address = [COLOR=#ff0000][B]Range("E2:E10")[/B][/COLOR].Address Then Range("A1").Value = 0
End Sub

Kết quả là không thấy có hiện tượng gì.
Phiền các bạn chỉ giúp mình làm sao để khi di chuyển vùng theo trường hợp 2 thì điều kiện có thể hoạt động được với.

Xin cảm ơn!
 
Lần chỉnh sửa cuối:
Upvote 0
Chào các bạn!Mình đang vướng mắc một sự cố mong các bạn giúp đỡ.

ví dụ với đoạn code này thì OK.
Mã:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = [COLOR=#008000][B]Range("C2")[/B][/COLOR].Address Then Range("A1").Value = 1
    If Target.Address = [COLOR=#008000][B]Range("E2")[/B][/COLOR].Address Then Range("A1").Value = 0
End Sub

Nhưng mình muốn mở rộng hơn 1 chút nữa là chuyển từ 1 Cell thành 1 vùng thì thế này:
Mã:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = [COLOR=#ff0000][B]Range("C2:C10")[/B][/COLOR].Address Then Range("A1").Value = 1
    If Target.Address = [COLOR=#ff0000][B]Range("E2:E10")[/B][/COLOR].Address Then Range("A1").Value = 0
End Sub

Kết quả là không thấy có hiện tượng gì.
Phiền các bạn chỉ giúp mình làm sao để khi di chuyển vùng theo trường hợp 2 thì code không bị lỗi với.

Xin cảm ơn!

Bạn chạy thử code này:

Mã:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("C2:C10")) Is Nothing Then Range("A1").Value = 1
    If Not Intersect(Target, Range("E2:E10")) Is Nothing Then Range("A1").Value = 0
End Sub
 
Upvote 0
Cảm ơn bạn nhiều code đã hoạt động đúng ý mình!
 
Upvote 0
xin chào ACE, tôi đang mài mò thử hoc Dictionary để lọc giá trị duy nhất trong một danh sách với d0ọc code sau
Mã:
Private Sub CommandButton1_Click()
Dim Dic As Object, I As Long, J As Long, K As Long, Arr(), dArr(), Tem As String
[f5:G100].ClearContents
Arr = [c5:D13].Value
ReDim dArr(1 To UBound(Arr, 1), 1 To 2)

For I = 1 To UBound(Arr)
Set Dic = CreateObject("Scripting.Dictionary")
Tem = Arr(I, 1)
    If Not Dic.Exists(Tem) Then
            K = K + 1: Dic.Add Tem, K
            For J = 1 To 2
                dArr(K, J) = Arr(I, J)
            Next J
    End If
Next I

[f5].Resize(K, 2).Value = dArr
Set Dic = Nothing
End Sub

không biết là nó sai chổ nào mà chẳng có lọc gì hết............
nhờ anh chỉ sử lại dùm
cám ơn nhiều
 

File đính kèm

  • Dic.xls
    25.5 KB · Đọc: 8
Upvote 0
xin chào ACE, tôi đang mài mò thử hoc Dictionary để lọc giá trị duy nhất trong một danh sách với d0ọc code sau
Mã:
Private Sub CommandButton1_Click()
Dim Dic As Object, I As Long, J As Long, K As Long, Arr(), dArr(), Tem As String
[f5:G100].ClearContents
Arr = [c5:D13].Value
ReDim dArr(1 To UBound(Arr, 1), 1 To 2)

For I = 1 To UBound(Arr)
Set Dic = CreateObject("Scripting.Dictionary")
Tem = Arr(I, 1)
    If Not Dic.Exists(Tem) Then
            K = K + 1: Dic.Add Tem, K
            For J = 1 To 2
                dArr(K, J) = Arr(I, J)
            Next J
    End If
Next I

[f5].Resize(K, 2).Value = dArr
Set Dic = Nothing
End Sub

không biết là nó sai chổ nào mà chẳng có lọc gì hết............
nhờ anh chỉ sử lại dùm
cám ơn nhiều
1)- Híc, sao Set Dic trong vòng lặp, đưa ra ngoài chứ
2)- Khi có dữ liệu trùng thì làm gì, phải thêm vào code
Thân
 
Upvote 0
1)- Híc, sao Set Dic trong vòng lặp, đưa ra ngoài chứ
2)- Khi có dữ liệu trùng thì làm gì, phải thêm vào code
Thân

cám ơn anh, anh ơi cho hoi thêm, nếu nguồn của mình là từ [C5:E13] tức là thêm một cột
nhưng khi lọc thì chỉ lấy ở cột C và E thôi, ko lấy cột D thỉ phải là sao?
 
Upvote 0
cám ơn anh, anh ơi cho hoi thêm, nếu nguồn của mình là từ [C5:E13] tức là thêm một cột
nhưng khi lọc thì chỉ lấy ở cột C và E thôi, ko lấy cột D thỉ phải là sao?

Lấy cột nào thì cứ.. lấy thôi
Mã:
Private Sub CommandButton1_Click()
  Dim Dic As Object, I As Long, J As Long, K As Long, Arr(), dArr(), Tem As String
  [f5:G100].ClearContents
  [COLOR=#ff0000]Arr = [C5:E13].Value[/COLOR]
  ReDim dArr(1 To UBound(Arr, 1), 1 To 2)
  Set Dic = CreateObject("Scripting.Dictionary")
  For I = 1 To UBound(Arr)
    Tem = Arr(I, 1)
    If Not Dic.Exists(Tem) Then
      K = K + 1
      Dic.Add Tem, K
      dArr(K, 1) = Arr(I, 1)
      [COLOR=#ff0000][B]dArr(K, 2) = Arr(I, 3)[/B][/COLOR]
    End If
  Next I
  [f5].Resize(K, 2).Value = dArr
  Set Dic = Nothing
End Sub
Có vấn đề gì chứ
 
Upvote 0
Cho em hỏi Code của chương trình So_Mucke

Đây là Code do bác Ba Tê viết giúp em và em đã cải tiến một số phần để phục vụ công việc tuy nhiên khi xử lý Code thì em chưa có kinh nghiệm nhiều, mọi người cho em hỏi chút ạ
PHP:
Public Sub LOC_BIEU1()
On Error Resume Next
Dim sArr(), dArr(1 To 3, 1 To 1), I As Long, To_BD As String, DK As String, Ong As String, Ong2 As String, Ong3 As String
Dim K As Long, dArr2(1 To 1000, 1 To 12), N As Long, SoTrang As Double, Le As Boolean
Dim loai_DT1 As String, loai_DT2 As String
Dim Cap_GCN1 As String, Cap_GCN2 As String, Cap_GCN3 As String, Cap_GCN4 As String, Cap_GCN5 As String, Cap_GCN6 As String
Dim Cap_GCN7 As String, Cap_GCN8 As String, Cap_GCN9 As String, Cap_GCN10 As String, Cap_GCN11 As String, Cap_GCN12 As String
Dim Cap_GCN13 As String, Cap_GCN14 As String, Cap_GCN15 As String, Cap_GCN16 As String, Cap_GCN17 As String, Cap_GCN18 As String
Dim Cap_GCN19 As String, Cap_GCN20 As String, Cap_GCN21 As String, Cap_GCN22 As String, Cap_GCN23 As String, Cap_GCN24 As String
Dim Cap_GCN25 As String, Cap_GCN26 As String, Cap_GCN27 As String, Cap_GCN28 As String, Cap_GCN29 As String, Cap_GCN30 As String
Dim Cap_GCN31 As String, Cap_GCN32 As String, Cap_GCN33 As String, Cap_GCN34 As String, Cap_GCN35 As String, Cap_GCN36 As String
Dim Cap_GCN37 As String, Cap_GCN38 As String, Cap_GCN39 As String, Cap_GCN40 As String
With Sheets("DATA")
    sArr = .Range(.[A3], .[A65536].End(xlUp)).Resize(, 21).Value
End With

With Sheets("BIEU")
DK = .[M5].Value: To_BD = .[O7].Value: Ong = .[O8].Value: Ong2 = .[O9].Value: Ong3 = .[O10].Value
loai_DT1 = .[O11].Value: loai_DT2 = .[O12].Value
Cap_GCN1 = .[X5].Value: Cap_GCN2 = .[X6].Value: Cap_GCN3 = .[X7].Value: Cap_GCN4 = .[X8].Value: Cap_GCN5 = .[X9].Value: Cap_GCN6 = .[X10].Value
Cap_GCN7 = .[X11].Value: Cap_GCN8 = .[X12].Value: Cap_GCN9 = .[X13].Value: Cap_GCN10 = .[X14].Value: Cap_GCN11 = .[X15].Value: Cap_GCN12 = .[X16].Value
Cap_GCN13 = .[X17].Value: Cap_GCN14 = .[X18].Value: Cap_GCN15 = .[X19].Value: Cap_GCN16 = .[X20].Value: Cap_GCN17 = .[X21].Value: Cap_GCN18 = .[X22].Value
Cap_GCN19 = .[X23].Value: Cap_GCN20 = .[X24].Value: Cap_GCN21 = .[X25].Value: Cap_GCN22 = .[X26].Value: Cap_GCN23 = .[X27].Value: Cap_GCN24 = .[X28].Value
Cap_GCN25 = .[X29].Value: Cap_GCN26 = .[X30].Value: Cap_GCN27 = .[X31].Value: Cap_GCN28 = .[X32].Value: Cap_GCN29 = .[X33].Value: Cap_GCN30 = .[X34].Value
Cap_GCN31 = .[X35].Value: Cap_GCN32 = .[X36].Value: Cap_GCN33 = .[X37].Value: Cap_GCN34 = .[X38].Value: Cap_GCN35 = .[X39].Value: Cap_GCN36 = .[X40].Value
Cap_GCN37 = .[X41].Value: Cap_GCN38 = .[X42].Value: Cap_GCN39 = .[X43].Value: Cap_GCN40 = .[X44].Value

For I = 1 To UBound(sArr, 1)
    If sArr(I, 1) = DK Then
        dArr(1, 1) = To_BD & sArr(I, 1)
Exit For
    End If
Next I
For N = I To UBound(sArr, 1)
    If sArr(N, 1) = DK Then
        K = K + 1
                dArr2(K, 1) = sArr(N, 2)
                dArr2(K, 4) = sArr(N, 4)
                dArr2(K, 7) = sArr(N, 5)
        
        If sArr(N, 5) = "LUC" Then
                dArr2(K, 5) = Cap_GCN1
            ElseIf sArr(N, 5) = "LUK" Then
                dArr2(K, 5) = Cap_GCN1
            ElseIf sArr(N, 5) = "LUN" Then
                dArr2(K, 5) = Cap_GCN1
            ElseIf sArr(N, 5) = "COC" Then
                dArr2(K, 5) = Cap_GCN2
            ElseIf sArr(N, 5) = "BHK" Then
                dArr2(K, 5) = Cap_GCN3
            ElseIf sArr(N, 5) = "NHK" Then
                dArr2(K, 5) = Cap_GCN3
            ElseIf sArr(N, 5) = "LNC" Then
                dArr2(K, 5) = Cap_GCN4
            ElseIf sArr(N, 5) = "LNQ" Then
                dArr2(K, 5) = Cap_GCN4
            ElseIf sArr(N, 5) = "LNk" Then
                dArr2(K, 5) = Cap_GCN4
            ElseIf sArr(N, 5) = "TSL" Then
                dArr2(K, 5) = Cap_GCN5
            ElseIf sArr(N, 5) = "TSN" Then
                dArr2(K, 5) = Cap_GCN5
            ElseIf sArr(N, 5) = "LMU" Then
                dArr2(K, 5) = Cap_GCN6
            ElseIf sArr(N, 5) = "NKH" Then
                dArr2(K, 5) = Cap_GCN7
            ElseIf sArr(N, 5) = "RSN" Then
                dArr2(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RST" Then
                dArr2(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RSK" Then
                dArr2(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RSM" Then
                dArr2(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RPN" Then
                dArr2(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RPT" Then
                dArr2(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RPK" Then
                dArr2(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RPM" Then
                dArr2(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RDN" Then
                dArr2(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "RDT" Then
                dArr2(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "RDK" Then
                dArr2(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "RDM" Then
                dArr2(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "ONT" Then
                dArr2(K, 5) = Cap_GCN11
            ElseIf sArr(N, 5) = "ODT" Then
                dArr2(K, 5) = Cap_GCN12
            ElseIf sArr(N, 5) = "TSC" Then
                dArr2(K, 5) = Cap_GCN13
            ElseIf sArr(N, 5) = "TSK" Then
                dArr2(K, 5) = Cap_GCN14
            ElseIf sArr(N, 5) = "CQP" Then
                dArr2(K, 5) = Cap_GCN15
            ElseIf sArr(N, 5) = "CAN" Then
                dArr2(K, 5) = Cap_GCN16
            ElseIf sArr(N, 5) = "SKK" Then
                dArr2(K, 5) = Cap_GCN17
            ElseIf sArr(N, 5) = "SKC" Then
                dArr2(K, 5) = Cap_GCN18
            ElseIf sArr(N, 5) = "SKS" Then
                dArr2(K, 5) = Cap_GCN19
            ElseIf sArr(N, 5) = "SKX" Then
                dArr2(K, 5) = Cap_GCN20
            ElseIf sArr(N, 5) = "DGT" Then
                dArr2(K, 5) = Cap_GCN21
            ElseIf sArr(N, 5) = "DTL" Then
                dArr2(K, 5) = Cap_GCN22
            ElseIf sArr(N, 5) = "DNL" Then
                dArr2(K, 5) = Cap_GCN23
            ElseIf sArr(N, 5) = "DBV" Then
                dArr2(K, 5) = Cap_GCN24
            ElseIf sArr(N, 5) = "DVH" Then
                dArr2(K, 5) = Cap_GCN25
            ElseIf sArr(N, 5) = "DYT" Then
                dArr2(K, 5) = Cap_GCN26
            ElseIf sArr(N, 5) = "DGD" Then
                dArr2(K, 5) = Cap_GCN27
            ElseIf sArr(N, 5) = "DTT" Then
                dArr2(K, 5) = Cap_GCN28
            ElseIf sArr(N, 5) = "DKH" Then
                dArr2(K, 5) = Cap_GCN29
            ElseIf sArr(N, 5) = "DXH" Then
                dArr2(K, 5) = Cap_GCN30
            ElseIf sArr(N, 5) = "DCH" Then
                dArr2(K, 5) = Cap_GCN31
            ElseIf sArr(N, 5) = "DDT" Then
                dArr2(K, 5) = Cap_GCN32
            ElseIf sArr(N, 5) = "DRA" Then
                dArr2(K, 5) = Cap_GCN33
            ElseIf sArr(N, 5) = "TON" Then
                dArr2(K, 5) = Cap_GCN34
            ElseIf sArr(N, 5) = "TIN" Then
                dArr2(K, 5) = Cap_GCN35
            ElseIf sArr(N, 5) = "NTD" Then
                dArr2(K, 5) = Cap_GCN36
            ElseIf sArr(N, 5) = "SON" Then
                dArr2(K, 5) = Cap_GCN37
            ElseIf sArr(N, 5) = "MNC" Then
                dArr2(K, 5) = Cap_GCN38
            ElseIf sArr(N, 5) = "PNK" Then
                dArr2(K, 5) = Cap_GCN39
            ElseIf sArr(N, 5) = "BCS" Then
                dArr2(K, 5) = Cap_GCN40
            ElseIf sArr(N, 5) = "DCS" Then
                dArr2(K, 5) = Cap_GCN40
            ElseIf sArr(N, 5) = "NCS" Then
                dArr2(K, 5) = Cap_GCN40
            
            Else
                dArr2(K, 5) = vbNullString
        End If
         
         If sArr(N, 6) = 1 Then
                dArr2(K, 3) = loai_DT1
            ElseIf sArr(N, 6) = 2 Then
                dArr2(K, 3) = loai_DT1
            ElseIf sArr(N, 6) = 3 Then
                dArr2(K, 3) = loai_DT2
            ElseIf sArr(N, 6) = 4 Then
                dArr2(K, 3) = loai_DT2
            ElseIf sArr(N, 6) = 5 Then
                dArr2(K, 3) = loai_DT2
            Else
                dArr2(K, 3) = vbNullString
        End If
                
                
        If sArr(N, 6) = 1 Then
                dArr2(K, 2) = Ong & sArr(N, 3)
            ElseIf sArr(N, 6) = 2 Then
                dArr2(K, 2) = Ong2 & sArr(N, 3)
            ElseIf sArr(N, 6) = 3 Then
                dArr2(K, 2) = Ong3 & sArr(N, 3)
            ElseIf sArr(N, 6) = 4 Then
                dArr2(K, 2) = Ong3 & sArr(N, 3)
            ElseIf sArr(N, 6) = 5 Then
                dArr2(K, 2) = Ong3 & sArr(N, 3)
            Else
                dArr2(K, 2) = vbNullString
        End If
    End If
Next N
Application.EnableEvents = False
.[A1].Value = dArr
.[A5:L43].Value = dArr2
SoTrang = K \ 39
If SoTrang > 0 Then
    If K Mod 39 > 0 Then SoTrang = SoTrang + 1
Else
    SoTrang = 1
End If
.[N4].Value = SoTrang
.[O4].Value = 1
Application.EnableEvents = True
End With
End Sub


Public Sub LOC_BIEU2()
Dim sArr(), dArr(), dArr2(), I As Long, J As Long, K As Long, N As Long, K1 As Long, XemTrang As Long
Dim SoTrang As Long, D As Long, DK As String, Ong As String, Ong2 As String, Ong3 As String
Dim loai_DT1 As String, loai_DT2 As String
Dim Cap_GCN1 As String, Cap_GCN2 As String, Cap_GCN3 As String, Cap_GCN4 As String, Cap_GCN5 As String, Cap_GCN6 As String
Dim Cap_GCN7 As String, Cap_GCN8 As String, Cap_GCN9 As String, Cap_GCN10 As String, Cap_GCN11 As String, Cap_GCN12 As String
Dim Cap_GCN13 As String, Cap_GCN14 As String, Cap_GCN15 As String, Cap_GCN16 As String, Cap_GCN17 As String, Cap_GCN18 As String
Dim Cap_GCN19 As String, Cap_GCN20 As String, Cap_GCN21 As String, Cap_GCN22 As String, Cap_GCN23 As String, Cap_GCN24 As String
Dim Cap_GCN25 As String, Cap_GCN26 As String, Cap_GCN27 As String, Cap_GCN28 As String, Cap_GCN29 As String, Cap_GCN30 As String
Dim Cap_GCN31 As String, Cap_GCN32 As String, Cap_GCN33 As String, Cap_GCN34 As String, Cap_GCN35 As String, Cap_GCN36 As String
Dim Cap_GCN37 As String, Cap_GCN38 As String, Cap_GCN39 As String, Cap_GCN40 As String
With Sheets("DATA")
    sArr = .Range(.[A3], .[A65536].End(xlUp)).Resize(, 21).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 12)
With Sheets("BIEU")
DK = .[M5].Value: SoTrang = .[N4].Value: XemTrang = .[O4].Value
loai_DT1 = .[O11].Value: loai_DT2 = .[O12].Value: Ong = .[O8].Value: Ong2 = .[O9].Value: Ong3 = .[O10].Value
Cap_GCN1 = .[X5].Value: Cap_GCN2 = .[X6].Value: Cap_GCN3 = .[X7].Value: Cap_GCN4 = .[X8].Value: Cap_GCN5 = .[X9].Value: Cap_GCN6 = .[X10].Value
Cap_GCN7 = .[X11].Value: Cap_GCN8 = .[X12].Value: Cap_GCN9 = .[X13].Value: Cap_GCN10 = .[X14].Value: Cap_GCN11 = .[X15].Value: Cap_GCN12 = .[X16].Value
Cap_GCN13 = .[X17].Value: Cap_GCN14 = .[X18].Value: Cap_GCN15 = .[X19].Value: Cap_GCN16 = .[X20].Value: Cap_GCN17 = .[X21].Value: Cap_GCN18 = .[X22].Value
Cap_GCN19 = .[X23].Value: Cap_GCN20 = .[X24].Value: Cap_GCN21 = .[X25].Value: Cap_GCN22 = .[X26].Value: Cap_GCN23 = .[X27].Value: Cap_GCN24 = .[X28].Value
Cap_GCN25 = .[X29].Value: Cap_GCN26 = .[X30].Value: Cap_GCN27 = .[X31].Value: Cap_GCN28 = .[X32].Value: Cap_GCN29 = .[X33].Value: Cap_GCN30 = .[X34].Value
Cap_GCN31 = .[X35].Value: Cap_GCN32 = .[X36].Value: Cap_GCN33 = .[X37].Value: Cap_GCN34 = .[X38].Value: Cap_GCN35 = .[X39].Value: Cap_GCN36 = .[X40].Value
Cap_GCN37 = .[X41].Value: Cap_GCN38 = .[X42].Value: Cap_GCN39 = .[X43].Value: Cap_GCN40 = .[X44].Value

For N = 1 To UBound(sArr, 1)
    If sArr(N, 1) = DK Then
        K = K + 1
            dArr(K, 1) = sArr(N, 2)
            dArr(K, 4) = sArr(N, 4)
            dArr(K, 7) = sArr(N, 5)
            
        If sArr(N, 5) = "LUC" Then
                dArr(K, 5) = Cap_GCN1
            ElseIf sArr(N, 5) = "LUK" Then
                dArr(K, 5) = Cap_GCN1
            ElseIf sArr(N, 5) = "LUN" Then
                dArr(K, 5) = Cap_GCN1
            ElseIf sArr(N, 5) = "COC" Then
                dArr(K, 5) = Cap_GCN2
            ElseIf sArr(N, 5) = "BHK" Then
                dArr(K, 5) = Cap_GCN3
            ElseIf sArr(N, 5) = "NHK" Then
                dArr(K, 5) = Cap_GCN3
            ElseIf sArr(N, 5) = "LNC" Then
                dArr(K, 5) = Cap_GCN4
            ElseIf sArr(N, 5) = "LNQ" Then
                dArr(K, 5) = Cap_GCN4
            ElseIf sArr(N, 5) = "LNk" Then
                dArr(K, 5) = Cap_GCN4
            ElseIf sArr(N, 5) = "TSL" Then
                dArr(K, 5) = Cap_GCN5
            ElseIf sArr(N, 5) = "TSN" Then
                dArr(K, 5) = Cap_GCN5
            ElseIf sArr(N, 5) = "LMU" Then
                dArr(K, 5) = Cap_GCN6
            ElseIf sArr(N, 5) = "NKH" Then
                dArr(K, 5) = Cap_GCN7
            ElseIf sArr(N, 5) = "RSN" Then
                dArr(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RST" Then
                dArr(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RSK" Then
                dArr(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RSM" Then
                dArr(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RPN" Then
                dArr(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RPT" Then
                dArr(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RPK" Then
                dArr(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RPM" Then
                dArr(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RDN" Then
                dArr(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "RDT" Then
                dArr(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "RDK" Then
                dArr(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "RDM" Then
                dArr(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "ONT" Then
                dArr(K, 5) = Cap_GCN11
            ElseIf sArr(N, 5) = "ODT" Then
                dArr(K, 5) = Cap_GCN12
            ElseIf sArr(N, 5) = "TSC" Then
                dArr(K, 5) = Cap_GCN13
            ElseIf sArr(N, 5) = "TSK" Then
                dArr(K, 5) = Cap_GCN14
            ElseIf sArr(N, 5) = "CQP" Then
                dArr(K, 5) = Cap_GCN15
            ElseIf sArr(N, 5) = "CAN" Then
                dArr(K, 5) = Cap_GCN16
            ElseIf sArr(N, 5) = "SKK" Then
                dArr(K, 5) = Cap_GCN17
            ElseIf sArr(N, 5) = "SKC" Then
                dArr(K, 5) = Cap_GCN18
            ElseIf sArr(N, 5) = "SKS" Then
                dArr(K, 5) = Cap_GCN19
            ElseIf sArr(N, 5) = "SKX" Then
                dArr(K, 5) = Cap_GCN20
            ElseIf sArr(N, 5) = "DGT" Then
                dArr(K, 5) = Cap_GCN21
            ElseIf sArr(N, 5) = "DTL" Then
                dArr(K, 5) = Cap_GCN22
            ElseIf sArr(N, 5) = "DNL" Then
                dArr(K, 5) = Cap_GCN23
            ElseIf sArr(N, 5) = "DBV" Then
                dArr(K, 5) = Cap_GCN24
            ElseIf sArr(N, 5) = "DVH" Then
                dArr(K, 5) = Cap_GCN25
            ElseIf sArr(N, 5) = "DYT" Then
                dArr(K, 5) = Cap_GCN26
            ElseIf sArr(N, 5) = "DGD" Then
                dArr(K, 5) = Cap_GCN27
            ElseIf sArr(N, 5) = "DTT" Then
                dArr(K, 5) = Cap_GCN28
            ElseIf sArr(N, 5) = "DKH" Then
                dArr(K, 5) = Cap_GCN29
            ElseIf sArr(N, 5) = "DXH" Then
                dArr(K, 5) = Cap_GCN30
            ElseIf sArr(N, 5) = "DCH" Then
                dArr(K, 5) = Cap_GCN31
            ElseIf sArr(N, 5) = "DDT" Then
                dArr(K, 5) = Cap_GCN32
            ElseIf sArr(N, 5) = "DRA" Then
                dArr(K, 5) = Cap_GCN33
            ElseIf sArr(N, 5) = "TON" Then
                dArr(K, 5) = Cap_GCN34
            ElseIf sArr(N, 5) = "TIN" Then
                dArr(K, 5) = Cap_GCN35
            ElseIf sArr(N, 5) = "NTD" Then
                dArr(K, 5) = Cap_GCN36
            ElseIf sArr(N, 5) = "SON" Then
                dArr(K, 5) = Cap_GCN37
            ElseIf sArr(N, 5) = "MNC" Then
                dArr(K, 5) = Cap_GCN38
            ElseIf sArr(N, 5) = "PNK" Then
                dArr(K, 5) = Cap_GCN39
            ElseIf sArr(N, 5) = "BCS" Then
                dArr(K, 5) = Cap_GCN40
            ElseIf sArr(N, 5) = "DCS" Then
                dArr(K, 5) = Cap_GCN40
            ElseIf sArr(N, 5) = "NCS" Then
                dArr(K, 5) = Cap_GCN40
            
            Else
                dArr(K, 5) = vbNullString
        End If
            
            If sArr(N, 6) = 1 Then
                dArr(K, 3) = loai_DT1
            ElseIf sArr(N, 6) = 2 Then
                dArr(K, 3) = loai_DT1
            ElseIf sArr(N, 6) = 3 Then
                dArr(K, 3) = loai_DT2
            ElseIf sArr(N, 6) = 4 Then
                dArr(K, 3) = loai_DT2
            ElseIf sArr(N, 6) = 5 Then
                dArr(K, 3) = loai_DT2
            Else
                dArr(K, 3) = vbNullString
        End If
                       
        If sArr(N, 6) = 1 Then
                dArr(K, 2) = Ong & sArr(N, 3)
            ElseIf sArr(N, 6) = 2 Then
                dArr(K, 2) = Ong2 & sArr(N, 3)
            ElseIf sArr(N, 6) = 3 Then
                dArr(K, 2) = Ong3 & sArr(N, 3)
            ElseIf sArr(N, 6) = 4 Then
                dArr(K, 2) = Ong3 & sArr(N, 3)
            ElseIf sArr(N, 6) = 5 Then
                dArr(K, 2) = Ong3 & sArr(N, 3)
            Else
                dArr(K, 2) = vbNullString
        End If
    End If
Next N
ReDim dArr2(1 To UBound(dArr, 1), 1 To 12)
If XemTrang <= SoTrang Then
    D = XemTrang * 39 - 38
    For I = D To K
        K1 = K1 + 1
        For J = 1 To 10
            dArr2(K1, J) = dArr(I, J)
        Next J
    Next I
End If
.[A5:L43].Value = dArr2
End With
End Sub

Public Sub BATE()
Application.EnableEvents = True
End Sub

Public Sub IN_BIEU()
UForm1.Show
End Sub
Chương trình em khai báo nhiều biến qúa để xử lý câu lệnh bời vì em chưa biết nhiều về Mảng
mọi người giúp em rút gọn bớt Code của chương trình với ạ (Chương trình nằm trong Module2)
Thanks
 
Upvote 0
Đây là Code do bác Ba Tê viết giúp em và em đã cải tiến một số phần để phục vụ công việc tuy nhiên khi xử lý Code thì em chưa có kinh nghiệm nhiều, mọi người cho em hỏi chút ạ
PHP:
Public Sub LOC_BIEU1()
..............
Chương trình em khai báo nhiều biến qúa để xử lý câu lệnh bời vì em chưa biết nhiều về Mảng
mọi người giúp em rút gọn bớt Code của chương trình với ạ (Chương trình nằm trong Module2)
Thanks


Theo mình ở đây bạn muốn nhờ người khác giúp đỡ viết code. Và thực tế bác Ba Tê đã giúp bạn làm điều đó rất nhiệt tình và tôi không nhầm thì công việc của bạn cũng đã được giải quyết. Bây giờ bạn lại muốn rút ngắn code tôi chưa hiểu ý của bạn là bạn đang muốn học VBA hay làm gì khi bạn muốn rút ngắn code.

 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Ở đây em muốn học VBA để phục vụ cho công việc của mình tuy nhiên khi xử lý chương trình của mình cho phù hợp ở Sheet(BIEU) là em có cột X là mã Loại đất và khi lấy dữ liệu bên cột MDSD Sheet(DATA) thì em phải khai báo thêm nhiều biến quá
Mã:
Cap_GCN1 = .[X5].Value: Cap_GCN2 = .[X6].Value: Cap_GCN3 = .[X7].Value: Cap_GCN4 = .[X8].Value: Cap_GCN5 = .[X9].Value: Cap_GCN6 = .[X10].Value .......

Và phải dùng nhiều lệnh If... Else... giờ em muốn các anh chị giúp là có cách nào truy xuất theo mảng để rút ngắn lài phần Code này của em không ạ
Mã:
If sArr(N, 5) = "LUC" Then
                dArr(K, 5) = Cap_GCN1
            ElseIf sArr(N, 5) = "LUK" Then
                dArr(K, 5) = Cap_GCN1
            ElseIf sArr(N, 5) = "LUN" Then
                dArr(K, 5) = Cap_GCN1
            ElseIf sArr(N, 5) = "COC" Then
                dArr(K, 5) = Cap_GCN2
            ElseIf sArr(N, 5) = "BHK" Then
                dArr(K, 5) = Cap_GCN3
            ElseIf sArr(N, 5) = "NHK" Then
                dArr(K, 5) = Cap_GCN3
            ElseIf sArr(N, 5) = "LNC" Then
                dArr(K, 5) = Cap_GCN4
            ElseIf sArr(N, 5) = "LNQ" Then
                dArr(K, 5) = Cap_GCN4
            ElseIf sArr(N, 5) = "LNk" Then
                dArr(K, 5) = Cap_GCN4
            ElseIf sArr(N, 5) = "TSL" Then
                dArr(K, 5) = Cap_GCN5
            ElseIf sArr(N, 5) = "TSN" Then
                dArr(K, 5) = Cap_GCN5
            ElseIf sArr(N, 5) = "LMU" Then
                dArr(K, 5) = Cap_GCN6
            ElseIf sArr(N, 5) = "NKH" Then
                dArr(K, 5) = Cap_GCN7
            ElseIf sArr(N, 5) = "RSN" Then
                dArr(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RST" Then
                dArr(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RSK" Then
                dArr(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RSM" Then
                dArr(K, 5) = Cap_GCN8
            ElseIf sArr(N, 5) = "RPN" Then
                dArr(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RPT" Then
                dArr(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RPK" Then
                dArr(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RPM" Then
                dArr(K, 5) = Cap_GCN9
            ElseIf sArr(N, 5) = "RDN" Then
                dArr(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "RDT" Then
                dArr(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "RDK" Then
                dArr(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "RDM" Then
                dArr(K, 5) = Cap_GCN10
            ElseIf sArr(N, 5) = "ONT" Then
                dArr(K, 5) = Cap_GCN11
            ElseIf sArr(N, 5) = "ODT" Then
                dArr(K, 5) = Cap_GCN12
            ElseIf sArr(N, 5) = "TSC" Then
                dArr(K, 5) = Cap_GCN13
            ElseIf sArr(N, 5) = "TSK" Then
                dArr(K, 5) = Cap_GCN14
            ElseIf sArr(N, 5) = "CQP" Then
                dArr(K, 5) = Cap_GCN15
            ElseIf sArr(N, 5) = "CAN" Then
                dArr(K, 5) = Cap_GCN16
            ElseIf sArr(N, 5) = "SKK" Then
                dArr(K, 5) = Cap_GCN17
            ElseIf sArr(N, 5) = "SKC" Then
                dArr(K, 5) = Cap_GCN18
            ElseIf sArr(N, 5) = "SKS" Then
                dArr(K, 5) = Cap_GCN19
            ElseIf sArr(N, 5) = "SKX" Then
                dArr(K, 5) = Cap_GCN20
            ElseIf sArr(N, 5) = "DGT" Then
                dArr(K, 5) = Cap_GCN21
            ElseIf sArr(N, 5) = "DTL" Then
                dArr(K, 5) = Cap_GCN22
            ElseIf sArr(N, 5) = "DNL" Then
                dArr(K, 5) = Cap_GCN23
            ElseIf sArr(N, 5) = "DBV" Then
                dArr(K, 5) = Cap_GCN24
            ElseIf sArr(N, 5) = "DVH" Then
                dArr(K, 5) = Cap_GCN25
            ElseIf sArr(N, 5) = "DYT" Then
                dArr(K, 5) = Cap_GCN26
            ElseIf sArr(N, 5) = "DGD" Then
                dArr(K, 5) = Cap_GCN27
            ElseIf sArr(N, 5) = "DTT" Then
                dArr(K, 5) = Cap_GCN28
            ElseIf sArr(N, 5) = "DKH" Then
                dArr(K, 5) = Cap_GCN29
            ElseIf sArr(N, 5) = "DXH" Then
                dArr(K, 5) = Cap_GCN30
            ElseIf sArr(N, 5) = "DCH" Then
                dArr(K, 5) = Cap_GCN31
            ElseIf sArr(N, 5) = "DDT" Then
                dArr(K, 5) = Cap_GCN32
            ElseIf sArr(N, 5) = "DRA" Then
                dArr(K, 5) = Cap_GCN33
            ElseIf sArr(N, 5) = "TON" Then
                dArr(K, 5) = Cap_GCN34
            ElseIf sArr(N, 5) = "TIN" Then
                dArr(K, 5) = Cap_GCN35
            ElseIf sArr(N, 5) = "NTD" Then
                dArr(K, 5) = Cap_GCN36
            ElseIf sArr(N, 5) = "SON" Then
                dArr(K, 5) = Cap_GCN37
            ElseIf sArr(N, 5) = "MNC" Then
                dArr(K, 5) = Cap_GCN38
            ElseIf sArr(N, 5) = "PNK" Then
                dArr(K, 5) = Cap_GCN39
            ElseIf sArr(N, 5) = "BCS" Then
                dArr(K, 5) = Cap_GCN40
            ElseIf sArr(N, 5) = "DCS" Then
                dArr(K, 5) = Cap_GCN40
            ElseIf sArr(N, 5) = "NCS" Then
                dArr(K, 5) = Cap_GCN40
            Else
                dArr(K, 5) = vbNullString
        End If

Đây chỉ có 40 mã nếu có nhiều hơn thì sao????
huuu
nhờ mọi người giúp đỡ ạ
thanks
 
Upvote 0
xin chào anh chị..............
tôi đang mài mò học cách viết vba bằng mảng.(giải bài tập của một bạn trên diễn đàn)
nhưng khi dùng 2 vòng lặp trên 2 mảng, khi trả về sheet thì thứ tự của nó ko đúng.
anh chi nào giúp với,
yêu cầu trong file
cám ơn nhiều
 

File đính kèm

  • Tong Hop Phieu Xuat .rar
    28.1 KB · Đọc: 13
Upvote 0
xin chào anh chị..............
tôi đang mài mò học cách viết vba bằng mảng.(giải bài tập của một bạn trên diễn đàn)
nhưng khi dùng 2 vòng lặp trên 2 mảng, khi trả về sheet thì thứ tự của nó ko đúng.
anh chi nào giúp với,
yêu cầu trong file
cám ơn nhiều

Bạn thử với sub này xem:

Mã:
Sub test()    
    Dim Dic As Object
    Dim QT As Variant, KHO As Variant, KQ() As Variant
    Dim i As Long, j As Long, k As Long, n As Long
    
    Application.ScreenUpdating = False
    Set Dic = CreateObject("Scripting.Dictionary")
    KHO = Sheet3.Range(Sheet3.Range("A2"), Sheet3.Range("A65000").End(xlUp)).Resize(, 5).Value
    With Sheet1
        QT = .Range(.Range("B3"), .Range("B65000").End(xlUp)).Resize(, 3).Value
        ReDim KQ(1 To UBound(QT), 1 To 1)
        If .Range("B65000").End(xlUp).Row > 2 Then
            For i = 1 To UBound(KHO)
                If IsDate(KHO(i, 1)) And Not Dic.exists(KHO(i, 3)) Then
                    Dic.Add KHO(i, 3), ""
                End If
            Next i
            For i = 1 To UBound(QT)
                k = 0
                If Dic.exists(QT(i, 3)) Then
                    For j = 1 To UBound(KHO)
                        If KHO(j, 3) = QT(i, 3) Then
                            For n = j + 1 To UBound(KHO)
                                If Not IsDate(KHO(n, 1)) Then
                                    k = k + 1
                                    KQ(i + k, 1) = KHO(n, 5)
                                Else
                                    Exit For
                                End If
                            Next n
                        End If
                    Next j
                End If
            Next i
            .Range("F3:F65000").ClearContents
            .Range("F3").Resize(i - 1).Value = KQ
        End If
    End With
    Set Dic = Nothing
    Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn thử với sub này xem:

[/CODE]

khó thất...hihihi...........viết trực tiếp trên sheet dể hình dung hơn...............hehehe.
anh có thể giải thích thêm cái lệnh này giúp với
Mã:
Dic.Add KHO(i, 3), ""
có thể hiểu vậy được ko anh
==>Dic add, lệnh nạp vào dic
==>KHO(i, 3), là phần tử nạp
==> vậy còn "" có nghĩa là sao ạh?, thông thường tôi thấy người ta hay thêm cái lệnh k=k+1
và lệnh nạp vào dic là
Mã:
Dic.Add KHO(i, 3), k
thì tôi hiểu là qua mỗi lần lặp, k tăng lên một lần, và các phần tử được nạp nối tiếp nhau vào trong dic. còn như trường hợp anh viết thì ko biết hiểu như thế nào?
mong anh giải thích giúp

p/s: tôi học theo kiểu thợ đụng,"đụng đâu học đó", nên ko có bài bảng....hihihih
cám ơn
 
Upvote 0
Web KT
Back
Top Bottom