Hỏi nhanh - Đáp nhanh về macro (dành cho các thành viên mới học lập trình)

tuananhya2 · 17/1/13

Co ai chỉ dùm cách tạo pass marco với

aviaiva · 4/2/13

quanghai1969 đã viết:
Theo mình thì câu lệnh trên đã in ra rồi, không có cài gì để hiện thông báo lên màn hình cả.
Kiên nhẫn đợi câu trả lời khác xem sao.

khi bắt đầu in nó hiện thông báo như sau (hình đính kèm)

em nghĩ có lẽ có một câu lệnh nào đó không cập nhật thông báo này dạng

[GPECODE=vb]application.(gì đó) = false[/GPECODE]

nhưng mà em không biết, em đã thử application.displayalert = false nhưng không được

ndu96081631 · 4/2/13

aviaiva đã viết:
khi bắt đầu in nó hiện thông báo như sau (hình đính kèm)

em nghĩ có lẽ có một câu lệnh nào đó không cập nhật thông báo này dạng

[GPECODE=vb]application.(gì đó) = false[/GPECODE]

nhưng mà em không biết, em đã thử application.displayalert = false nhưng không được

Cái thông báo ấy có vướng bận gì đâu mà bạn cần phải tắt nó không biết
tuy nhiên, có thể xem bài này:
http://www.mrexcel.com/forum/excel-..."now-printing"-visual-basic-applications.html
Tắt bằng các hàm API

Quang_Hải · 4/2/13

aviaiva đã viết:
khi bắt đầu in nó hiện thông báo như sau (hình đính kèm)

em nghĩ có lẽ có một câu lệnh nào đó không cập nhật thông báo này dạng

[GPECODE=vb]application.(gì đó) = false[/GPECODE]

nhưng mà em không biết, em đã thử application.displayalert = false nhưng không được

Làm thì chắc là được nhưng hơi vất vả nghen. Mình có xem qua đường link anh NDU giới thiệu nhưng thấy có vẻ không cần thiết phải cực khổ như thế. Để dành thời gian suy nghĩ cái cần hơn trước cái đã.

Hong.Van · 4/2/13

hoanglocphat đã viết:
Chào các bạn
Mình đang có khối từ ô D10 đến ô D30000, khối ô này là ngày tháng (định dạng theo kiểu dd/mm/yy) bây giờ trong khối cell này có lẫn một số ô không phải là ngày tháng (ví dụ: '03/02/12 hoặc abc, ....)
Bây giờ mình muốn các bạn giúp code để duyệt tất cả các ô trên, nếu ô nào kg phải là kiểu ngày tháng nói trên hoặc là test ... thì code sẽ tô ô bị lỗi màu đỏ! (nếu có bảng thông báo cell nào bị lỗi thì càng tốt)
Xin cảm ơn các bạn!

Bạn thử với code này xem sao!
Cell bị lỗi nhiều thì bấm mỏi tay! Khuyến mãi luôn MsgBox tiếng Việt có dấu của Thầy Ndu
---------------
Các Thầy cô cho em hỏi làm sao để gom tất cả các Cell bị lỗi để thể hiện trong MsgBox 1 lần?
Em cảm ơn!

Mã:

Sub Format_ColumnD()
Dim i, Arr(), Text As String
    [D10:D10000].Font.ColorIndex = 1
    Text = "Bi5 lo64i cell "
    Arr = Range([D10], [D65536].End(4))
    For i = 1 To UBound(Arr)
        If Arr(i, 1) <> "" Then
            If VarType(Arr(i, 1)) <> 7 Then
                Cells(i + 9, 4).Font.ColorIndex = 3
                CreateObject("WScript.Shell").Popup UniConvert(Text, "VNI") & Cells(i + 9, 4).Address, , "THÔNG BÁO by H.V", vbOKOnly
            End If: End If
    Next
End Sub

Quang_Hải · 4/2/13

Hong.Van đã viết:
Bạn thử với code này xem sao!
Cell bị lỗi nhiều thì bấm mỏi tay! Khuyến mãi luôn MsgBox tiếng Việt có dấu của Thầy Ndu
---------------
Các Thầy cô cho em hỏi làm sao để gom tất cả các Cell bị lỗi để thể hiện trong MsgBox 1 lần?
Em cảm ơn!

Mã:

Sub Format_ColumnD() Dim i, Arr(), Text As String [D10:D10000].Font.ColorIndex = 1 Text = "Bi5 lo64i cell " Arr = Range([D10], [D65536].End(4)) For i = 1 To UBound(Arr) If Arr(i, 1) <> "" Then If VarType(Arr(i, 1)) <> 7 Then Cells(i + 9, 4).Font.ColorIndex = 3 CreateObject("WScript.Shell").Popup UniConvert(Text, "VNI") & Cells(i + 9, 4).Address, , "THÔNG BÁO by H.V", vbOKOnly End If: End If Next End Sub

Phải vầy không?

PHP:

Sub to_mau()
Dim dl(), i, Res As String, text As String
text = "Bi5 lo64i ca1c cell na2y: "
dl = Range([D10], [D65536].End(3)).Value
For i = 1 To UBound(dl)
   If VarType(dl(i, 1)) <> 7 Then
      Res = Res & "," & "D" & i + 9
   End If
Next
Res = Replace(Res, ",", "", 1, 1)
Range(Res).Interior.ColorIndex = 6
CreateObject("WScript.Shell").Popup UniConvert(text, "VNI") & Res, , "THÔNG BÁO by H.V", vbOKOnly
End Sub

Hong.Van · 4/2/13

quanghai1969 đã viết:

Phải vầy không?

PHP:

Sub to_mau()
Dim dl(), i, Res As String, text As String
text = "Bi5 lo64i ca1c cell na2y: "
dl = Range([D10], [D65536].End(3)).Value
For i = 1 To UBound(dl)
   If VarType(dl(i, 1)) <> 7 Then
      Res = Res & "," & "D" & i + 9
   End If
Next
Res = Replace(Res, ",", "", 1, 1)
Range(Res).Interior.ColorIndex = 6
CreateObject("WScript.Shell").Popup UniConvert(text, "VNI") & Res, , "THÔNG BÁO by H.V", vbOKOnly
End Sub

Em còn đang mơ hồ cái này?

Mã:

Res = Replace(Res, ",", "", 1, 1)

Mục đích làm gì vậy anh ? nhờ anh giải thích, em cảm ơn!

Quang_Hải · 4/2/13

Hong.Van đã viết:
Em còn đang mơ hồ cái này?

Mã:

Res = Replace(Res, ",", "", 1, 1)

Mục đích làm gì vậy anh ? nhờ anh giải thích, em cảm ơn!

Khi mình nối các chuỗi lại với nhau thì lòi ra cái dấu "," phía trước. Cho nên phải dùng Replace để khử nó thôi mà

...Và hàm Replace còn 1 tham số nữa mà chúng ta ít dùng

PHP:

Sub Replace_Function()
Dim str As String
str = "Lap Trinh VBA Vba Trong Excel"
MsgBox Replace(str, "VBA", "")
MsgBox Replace(str, "VBA", "", , , 1)
End Sub

ndu96081631 · 4/2/13

Hong.Van đã viết:
Em còn đang mơ hồ cái này?

Mã:

Res = Replace(Res, ",", "", 1, 1)

Mục đích làm gì vậy anh ? nhờ anh giải thích, em cảm ơn!

Bạn có thể thí nghiệm để biết "nó" là gì
Thay dòng:
Res = Replace(Res, ",", "", 1, 1)
Bằng
MsgBox Res
Bạn sẽ thấy thằng Res thì dư 1 dấu phẩy ở đầu! Vậy phải bằng cách gì đó để loại bỏ dấu phẩy này, nếu không thì Range(Res) sẽ lỗi... và Replace là 1 trong các giải pháp (không thích thì có thể dùng Res = Mid(Res, 2) cũng chẳng có vấn đề gì)

hungpecc1 · 4/2/13

Mình có đoạn code như sau :

Mã:

Sub KTra()
    Tmparr = Union(Range("A1:A6"), Range("C1:C6")).Value
    For i = 1 To UBound(Tmparr, 1)
        Debug.Print Tmparr(i, 2)
    Next
End Sub

F5 báo lỗi Tmparr(i,2) <------ các anh chị trong GPE thích cho mình với

VetMini · 4/2/13

Có những trường hợp bắt lỗi ngày tháng không dễ dàng chỉ xét kiểu. Nếu nó thằng thừng là "abc" thì dễ nhưng nếu nó là 12345 thì bắt không được.
Khi bắt lỗi dữ liệu, người ta phải đặt ra giới hạn. Nếu đúng kiểu nhưng nằm ngoài giới hạn là bắt.
Tuy nhiên nếu dữ liệu sai mà vẫn nằm trong giới hạn thì có trời biết. Cái gì cũng có mức độ hợp lý của nó.

ndu96081631 · 4/2/13

quanghai1969 đã viết:

Phải vầy không?

PHP:

Sub to_mau()
Dim dl(), i, Res As String, text As String
text = "Bi5 lo64i ca1c cell na2y: "
dl = Range([D10], [D65536].End(3)).Value
For i = 1 To UBound(dl)
   If VarType(dl(i, 1)) <> 7 Then
      Res = Res & "," & "D" & i + 9
   End If
Next
Res = Replace(Res, ",", "", 1, 1)
Range(Res).Interior.ColorIndex = 6
CreateObject("WScript.Shell").Popup UniConvert(text, "VNI") & Res, , "THÔNG BÁO by H.V", vbOKOnly
End Sub

Phát hiện thêm 1 lỗi: Với dữ liệu khoảng 10,000 dòng thì phép nối chuổi bị phá sản ---> Trường hợp này cứ xử lý cell à chắc ăn nhất:

Mã:

Sub to_mau()
  Dim tmp, aData
  Dim i, lFirst As Long, n As Long, lR As Long
  With Range([D10], [D65536].End(3))
    .Font.ColorIndex = 0
    lFirst = .Row
    aData = .Value
  End With
  For i = 1 To UBound(aData)
    tmp = aData(i, 1)
    If VarType(tmp) <> 7 Then
      lR = i - 1 + lFirst
      Range("D" & lR).Font.ColorIndex = 3
    End If
  Next
  MsgBox "Done!"
End Sub

10,000 dòng cho tốc độ cũng rất nhanh

ndu96081631 · 4/2/13

hungpecc1 đã viết:
Mình có đoạn code như sau :

Mã:

Sub KTra() Tmparr = Union(Range("A1:A6"), Range("C1:C6")).Value For i = 1 To UBound(Tmparr, 1) Debug.Print Tmparr(i, 2) Next End Sub

F5 báo lỗi Tmparr(i,2) <------ các anh chị trong GPE thích cho mình với

Với dòng lệnh Tmparr = Union(Range("A1:A6"), Range("C1:C6")).Value
thì Tmparr cũng chỉ lấy được giá trị của Range("A1:A6"), còn Range("C1:C6") sẽ bị bỏ mất
Muốn vòng lập duyệt hết phải sửa thành:

Mã:

Sub KTra()
  Dim tmpArr, i As Long, rng As Range, rSub As Range
  Set rng = Union(Range("A1:A6"), Range("C1:C6"))
  For Each rSub In rng.[COLOR=#ff0000][B]Areas[/B][/COLOR]
    For i = 1 To rSub.Rows.Count
      Debug.Print rSub(i, 1)
    Next
  Next
End Sub

- Duyệt qua các vùng nhỏ trong vùng lớn
- Tiếp theo mới duyệt các giá trị trong vùng nhỏ

hungpecc1 · 4/2/13

cảm ơn anh ndu đã giúp

^^ biết thêm được thuộc tính areas

Hong.Van · 4/2/13

Trước đây em có đặt các công thức dưới đây trong C.F để tô màu:

PHP:

=MOD(RIGHT(C9;2)*1;3)=1

PHP:

=MOD(RIGHT(C9;2)*1;3)=2

PHP:

=MOD(RIGHT(C9;2)*1;3)=0

Bây giờ em viết code để thay thế C.F như sau

Mã:

Sub ToMau_C()
    Dim i As Long
    Dim arrRes, arrSrc, rng As Range
    [C9:C10000].Font.ColorIndex = 1
    [C9:C10000].Font.Bold = 0
    Set rng = Range([A9], [A65536].End(3)).Resize(, 37)
    arrSrc = rng.Value
    For i = 1 To UBound(arrSrc, 1)
        If Right(arrSrc(i, 3), 2) = "01" Or Right(arrSrc(i, 3), 2) = "04" Or Right(arrSrc(i, 3), 2) = "07" Or Right(arrSrc(i, 3), 2) = "10" Then
            rng(i, 3).Font.ColorIndex = 5
            
        End If
        If Right(arrSrc(i, 3), 2) = "02" Or Right(arrSrc(i, 3), 2) = "05" Or Right(arrSrc(i, 3), 2) = "08" Or Right(arrSrc(i, 3), 2) = "11" Then
            rng(i, 3).Font.ColorIndex = 13
            
        End If
        If Right(arrSrc(i, 3), 2) = "03" Or Right(arrSrc(i, 3), 2) = "06" Or Right(arrSrc(i, 3), 2) = "09" Or Right(arrSrc(i, 3), 2) = "12" Then
            rng(i, 3).Font.ColorIndex = 10
            
        End If
    Next i
End Sub

----------------
1/ Em muốn thử đưa 3 cthức nói trên vào code nhưng chưa biết bằng cách nào? và nếu đưa vào thì nó có nhanh hơn code dưới không?
2/ Em thấy code trên hơi dài dòng và chậm? có cách nào cải tiến cho nó nhanh hơn không?
Em cảm ơn!
--------
P/s: trong code em có Resize(, 37), mục đích em đang tính cho toàn bảng tính!!

hungpecc1 · 4/2/13

Hong.Van đã viết:
Trước đây em có đặt các công thức dưới đây trong C.F để tô màu:

PHP:

=MOD(RIGHT(C9;2)*1;3)=1

PHP:

=MOD(RIGHT(C9;2)*1;3)=2

PHP:

=MOD(RIGHT(C9;2)*1;3)=0

1/ Em muốn thử đưa 3 cthức nói trên vào code nhưng chưa biết bằng cách nào? và nếu đưa vào thì nó có nhanh hơn code dưới không?
2/ Em thấy code trên hơi dài dòng và chậm? có cách nào cải tiến cho nó nhanh hơn không?
Em cảm ơn!
--------
P/s: trong code em có Resize(, 37), mục đích em đang tính cho toàn bảng tính!!

Không hiểu ý bạn thế nào : --> nhưng nếu là mình , mình sẽ thử viết theo cách này ( chưa test, nên hổng biết có ok không )

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim CFval As Integer
If Target.Count = 1 And Intersect(Target, [C:C]) Is Nothing Then    
          CFval = Val(Right(Range("C" & Target.Row & ""), 2)) Mod 3    
          Select Case CFval        
            Case 0         
                   Target.Font.ColorIndex = 3       
            Case 1            
                   Target.Font.ColorIndex = 5        
            Case 2            
                  Target.Font.ColorIndex = 10    
          End Select
End If
End Sub

dhn46 · 4/2/13

hungpecc1 đã viết:
Không hiểu ý bạn thế nào : --> nhưng nếu là mình , mình sẽ thử viết theo cách này ( chưa test, nên hổng biết có ok không )

PHP:

Private Sub Worksheet_Change(ByVal Target As Range) Dim CFval As Integer If Target.Count = 1 And Intersect(Target, [C:C]) Is Nothing Then CFval = Val(Right(Range("C" & Target.Row & ""), 2)) Mod 3 Select Case CFval Case 0 Target.Font.ColorIndex = 3 Case 1 Target.Font.ColorIndex = 5 Case 2 Target.Font.ColorIndex = 10 End Select End If End Sub

Chưa Test nên không Ok là đúng rồi bạn
1 - Đoạn

Mã:

...And Intersect(Target, [C:C]) Is Nothing

Có nghĩa nếu Target là Nothing => Khi thay đổi tại cột C thì vô tác dụng
2- Đoạn

Mã:

...Right(Range("C" & Target.Row & ""), 2))....

Cái này đúng với T10, T11, T12 còn từ T1>T9 thì hổng có đúng
Mặt khác Target là 1 Range rồi thì chắc không cần Range nữa.
Vậy tôi tạm sửa thế này:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim CFval As Integer
If Target.Count = 1 And Not Intersect(Target, [C:C]) Is Nothing Then
          CFval = Val(Mid(Target, 2)) Mod 3
          Select Case CFval
            Case 0
                   Target.Font.ColorIndex = 3
            Case 1
                   Target.Font.ColorIndex = 5
            Case 2
                  Target.Font.ColorIndex = 10
          End Select
End If
End Sub

Hong.Van có thể tùy biến cho dữ liệu của mình

hungpecc1 · 5/2/13

dhn46 đã viết:
Chưa Test nên không Ok là đúng rồi bạn
1 - Đoạn

Mã:

...And Intersect(Target, [C:C]) Is Nothing

Có nghĩa nếu Target là Nothing => Khi thay đổi tại cột C thì vô tác dụng
................
[/code]
Hong.Van có thể tùy biến cho dữ liệu của mình

^^ cái này thì còn phải tuỳ theo ý đồ của bạn Hồng Vân :
* Vì mình không hiểu điều kiện CF của bạn là tại cột C, hay là tại các ô bất kỳ so với cột C

dhn46 · 5/2/13

hungpecc1 đã viết:
^^ cái này thì còn phải tuỳ theo ý đồ của bạn Hồng Vân :
* Vì mình không hiểu điều kiện CF của bạn là tại cột C, hay là tại các ô bất kỳ so với cột C

Đoạn:

Mã:

...And Intersect(Target, [C:C]) Is Nothing

Nếu bạn không thêm yếu tố Not thì có nghĩa: khi thay đổi giá trị tại cột C thì các lệnh sau if sẽ không thực hiện.

Quang_Hải · 5/2/13

ndu96081631 đã viết:
Phát hiện thêm 1 lỗi: Với dữ liệu khoảng 10,000 dòng thì phép nối chuổi bị phá sản ---> Trường hợp này cứ xử lý cell à chắc ăn nhất:

Mã:

Sub to_mau() Dim tmp, aData Dim i, lFirst As Long, n As Long, lR As Long With Range([D10], [D65536].End(3)) .Font.ColorIndex = 0 lFirst = .Row aData = .Value End With For i = 1 To UBound(aData) tmp = aData(i, 1) If VarType(tmp) <> 7 Then lR = i - 1 + lFirst Range("D" & lR).Font.ColorIndex = 3 End If Next MsgBox "Done!" End Sub

10,000 dòng cho tốc độ cũng rất nhanh

Qua bài này phát hiện ra 1 điều là phương thức Range nếu vượt quá 64 đối số thì phá sản (Office 2010)
Nên mình đành dùng phương án mượn thêm 1 cột phụt tuy hơi rườm rà nhưng vẫn cho 1 tốc độ khá nhanh

PHP:

Sub to_mau2()
Dim dl(), i, Res()
[E10:E65536].ClearContents
dl = Range([D10], [D65536].End(3)).Resize(, 2).Value
ReDim Res(1 To UBound(dl), 1 To 1)
For i = 1 To UBound(dl)
   If VarType(dl(i, 1)) = 7 Then Res(i, 1) = 1
Next
[E10].Resize(i - 1, 1) = Res
Range([E10], [D65536].End(3).Offset(, 1)).SpecialCells(4).Offset(, -1).Interior.ColorIndex = 6
[E10:E65536].ClearContents
End Sub

ndu96081631 · 5/2/13

quanghai1969 đã viết:
Qua bài này phát hiện ra 1 điều là phương thức Range nếu vượt quá 64 đối số thì phá sản (Office 2010)
Nên mình đành dùng phương án mượn thêm 1 cột phụt tuy hơi rườm rà nhưng vẫn cho 1 tốc độ khá nhanh

PHP:

Sub to_mau2() Dim dl(), i, Res() [E10:E65536].ClearContents dl = Range([D10], [D65536].End(3)).Resize(, 2).Value ReDim Res(1 To UBound(dl), 1 To 1) For i = 1 To UBound(dl) If VarType(dl(i, 1)) = 7 Then Res(i, 1) = 1 Next [E10].Resize(i - 1, 1) = Res Range([E10], [D65536].End(3).Offset(, 1)).SpecialCells(4).Offset(, -1).Interior.ColorIndex = 6 [E10:E65536].ClearContents End Sub

SpecialCells cũng nên tránh đối với dữ liệu lớn
Nhớ có 1 lần (lâu lắm rồi) khi dùng SpecialCells, nó báo lỗi gì đó khi số lượng Area vượt quá giới hạn, cuối cùng chẳng tính toán được gì cả

Hỏi nhanh - Đáp nhanh về macro (dành cho các thành viên mới học lập trình)

Thành viên mới

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

File đính kèm

Huyền thoại GPE

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

Busy

File đính kèm

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

Busy

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

Huyền thoại GPE

Thành viên gắn bó

Ăn cùng góc phố

Huyền thoại GPE

Huyền thoại GPE

Thành viên gắn bó

Busy

File đính kèm

Thành viên gắn bó

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

Thành viên gắn bó

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

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

Huyền thoại GPE

Facebook

Group