Chuyên mục xử lý, gỡ rối code VBA

Liên hệ QC
Status
Không mở trả lời sau này.

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia
5/6/08
Bài viết
30,703
Được thích
53,930
Code của Vanthinh luôn gọn gàng và tốc độ nhanh đúng phong cách của anh Nguyễn Duy Tuân;
Mã:
For I = 1 To UBound(sArr, 1)
        dArr(1, 1) = Format(Now, "mm/dd/yyyy hh:mm:ss")
        dArr(1, 2) = Application.UserName
...
Thiết lập giá trị cho 2 phần tử cố định dArr(1, 1), dArr(1, 2) trong vòng lặp? Nếu UBound(sArr, 1) = 100, 1000 thì cũng làm 100, 1000 lần cái việc chỉ cần làm 1 lần?

Tất nhiên ở đây chỉ có max 8 dòng nhưng tôi nói về nguyên tắc, về phong cách lập trình - vì bạn đang nói về phong cách của Tuân. Có lẽ Tuân sẽ cho 2 dòng trên ra ngoài vòng lặp chăng?

Với code thế này mà bạn nói thế thì tôi không biết bạn khen tác giả hay chê Nguyễn Duy Tuân.
 
Upvote 0
Trèo lên mụt đuôi kèo vuốt nhằm con mèo đuôi cụt.
 
Upvote 0
Chào thầy,
Em có bài tập VBA về Xác định 1 số có phải là Số nguyên tố hay không, nhưng em không hiểu đoạn code này là như thế nào. Mong thầy giải thích giúp em. Cảm ơn thầy.

Sub xet_snt()

Dim so, i, dem As Integer

so = Range("b1").Value

dem = 0

For i = 1 To so
If so Mod i = 0 Then
dem = dem + 1
End If
Next i

If dem = 2 Then
Range("b2").Value = so & " la so nguyen to"
Else
Range("b2").Value = so & " khong la so nguyen to"
End If
End Sub
 
Upvote 0
Mã:
Sub xet_snt()
  
    Dim so, i, dem As Integer
  
    so = Range("b1").Value
  
    dem = 0
  
    For i = 1 To so
        If so Mod i = 0 Then
            dem = dem + 1
        End If
    Next i
      
    If dem = 2 Then
        Range("b2").Value = so & " la so nguyen to"
    Else
        Range("b2").Value = so & " khong la so nguyen to"
    End If
End Sub
Ta biết rằng số n là số nguyên tố khi và chỉ khi chia hết cho 1 và cho chính nó.
dem = 2 có nghĩa là số tự nhiên so chỉ chia hết cho 1 và cho chính nó. Vì vậy nó là số nguyên tố.

Chỉ cần một số chú ý nhỏ thì số vòng lặp sẽ giảm rất nhiều.
1. Rõ rằng mọi số chẵn lớn hơn 2 không thể là số nguyên tố vì ngoài 1 và chính nó thì nó còn chia hết cho 2.
2. Nếu vd. dem = 3 thì rõ ràng điều kiện về sau If dem = 2 Then sẽ không thỏa vậy chả lý gì tiếp tục vòng lặp khi tình huống đó sảy ra. Vd. so = 2*3*10^6 = 6000000. Với 3 vòng lặp i = 1, 2, 3 đã có dem = 3. Chả lý gì thực hiện tiếp 5999997 vòng lặp khi biết trước sau thì cũng có dem = 2 = FALSE.
---------
Tất nhiên bài trong Excel thì chỉ dùng thuật toán đơn giản. Nhưng thuật toán trên có nhiều vòng không cần thiết. Ta chỉ xét trường hợp dùng kiến thức lớp 1, tức coi như không biết các định lý, thuật toán cao siêu.

Ta biết rằng nếu n là hợp số thì nó là tích của ít nhất 2 số tự nhiên > 1. Đây là kiến thức lớp 1 nên không có gì là cao siêu. Tức nếu n là hợp số thì tồn tại 2 ≤ a ≤ b sao cho n = a*b
Gọi p là một ước nguyên tố của a, tức a = p*c ta có n = p*c*b = p*d (p ≤ a ≤ b ≤ b*c = d)
=> p² ≤ p*d = n => p ≤ √n
Tức nếu n là hợp số thì nó phải có ít nhất 1 ước số nguyên tố nhỏ hơn hoặc bằng √n. Tất nhiên nếu n có ước ≤ √n thì nó phải là hợp số (vì số nguyên tố không chia hết cho cho số tự nhiên lớn hơn 1 và nhỏ hơn nó)

Chỉ với chú ý nhỏ này mà ta có code
Mã:
Function IsPrime(ByVal so As Long) As Boolean
Dim k As Long, a As Long
    If so < 2 Or ((so > 2) And (so Mod 2 = 0)) Then Exit Function
    a = Int(Sqr(so))
    For k = 3 To a Step 2
        If so Mod k = 0 Then Exit For
    Next k
    IsPrime = k > a
End Function
 
Upvote 0
Phụ thêm cho bài #1588 ở trên:

Bài toán xét số nguyên tố hình như là bài toán căn bản mà giáo viên dạy lập trình hầu như luôn luôn sẽ dùng để dạy. Nhất là khi bạn học lập trình căn bản như Pascal và C.
(tôi dùng từ "hình như" và "hầu như" là vì tôi nhận thấy khuynh hướng bây giờ như vậy)

Nó đặc biệt ở chỗ là 99% học sinh sẽ giản dị giải theo kiểu chia thử từ 1 đến n và đếm số ước. Theo nguyên tắc số nguyên tố chỉ chia chẵn cho 1 và chính nó, hễ số ước số lớn hơn 2 thì không phải là nguyên tố. Đây là giải thuật dựa trên định nghĩa số nguyên tố, và đó là giải thuật mà code bài #1587 được viết theo. Giải thuật hoàn toàn đúng nhưng đối với toán lẫn lập trình thì nó là chưa đạt - nếu tôi là người chấm bài thì tôi chấm tối đa 5/10

Theo luật toán lẫn lập trình, bài giải phải cộng thêm sự suy nghĩ và áp dụng những thủ thuật rút ngắn. Ví dụ bạn ra bài toán cho trẻ em: tìm những số chia chẵn cho 5; trẻ nào tìm bằng cách chia từng số cho 5 thì sẽ đạt 2/10; bài toán giải đúng phải là tìm những số kết bằng 5 hoặc 0.

Khi học toán số, lúc học tới số nguyên tố thì bạn cũng đồng thời học tính chất và cách xét:
1. ba số đầu 1,2,3 là số nguyên tố. Vì vậy chỉ xét những số lớn hơn 3
2. số nguyên tố lớn hơn 3 không thể là số chẵn. Vì vậy điều kiện kế đó là chỉ cần xét số lẻ
3. sau khi đã khẳng định là số lẻ rồi thì lúc chia thử để tìm ước số chỉ cần thử những số lẻ, bởi vì số chẵn đương nhiên không chia chẵn.
4. chỉ cần tìm được thêm 1 ước số rồi thì ngừng. Tìm thêm vô ích
5. theo luật đối xứng của ước số trong toán số, nếu b là ước số của a thì phải có một c sao cho c*b = a; và nếu b < căn 2 a thì c > căn 2 a, và ngược lại. Vì vậy, chỉ cần xét các ước số nhỏ hơn hoặc bằng số đã cho mà thôi.

Tóm lại, để xét n có phải là số nguyên tố thì tuần tự làm như sau:
(i) nếu n nhỏ hơn hoặc bằng 3 thì là số nguyên tố
(ii) nếu số là số chẵn thì không phải là số nguyên tố, không cần xét tiếp.
(iii) vòng lặp i từ 3 đến căn 2 của n; bước 2 (chỉ tính những số lẻ)
(iii).(a) nếu i chia chẵn n thì i là 1 ước số khác của n; thoát vòng lặp
(iv) hết vòng lặp, xét lại xem i đã tiến quá căn 2 của n chưa, nếu chưa thì là vòng lặp thoát sớm -> không phải số nguyên tố
 
Upvote 0
Mình có đoạn code sau:
mình chưa hiểu vì sao Combobox không xóa được,
nhưng với đoạn code này trong Combobox được nạp code thuộc mảng thì Clear được, vậy đối với trường hợp này thi xử lý như thế nào ngoài việc gán cho nó giá trị "".

Mã:
Private Sub CommandButton1_Click()
Me.ComboBox1.Clear
Me.ComboBox2.Clear
Me.ComboBox3.Clear
End Sub 
[CODE]

và sao với đoạn code này thì 1 số Form nó setfocus được, 1 số không set được

[code]
Private Sub UserForm_Initialize()
Me.ComboBox2.SetFocus
End Sub
[code]
 
Upvote 0
Sub tim_sheet()
Dim Tieude As String
Dim Timduoc As Boolean
Dim I As Integer, sosheet As Long
Dim TenSheet As String
Tieu de = "www.giaiphapexcel.com"
sosheet = ActiveSheet.Sheets.Count 'xac dinh so sheet trong workbook'
timtiep:
Tensheet=lcase(application.inputbox("Ban go ten cua sheet:",Tieude)
If TenSheet = "False" Then Exit Sub 'neu nguoi dung bam cancel
If TenSheet = "" Then
MsgBox "ban hay nhap ten sheet de tim:", vbExclamation, Tieude
GoTo timtiep 'quaytro lai nhan tim tiep
End If
Timduoc = False
For I = 1 To sosheet
If InStr(1, LCase(Sheets(I).Name), TenSheet) > 0 Then
Timduoc = True
Sheets(I).Select
If Msgbox ("Da tim duoc sheet co ten""""&TenSheet&""".Ban cos muon tim tiep khong?",vbYesNo+vbQuestion,Tieude)=vbYes Then Goto Timtiep
Exit For
End If
Next 'Neu khong tim duoc sheet
If Not Timduoc Then
msgbox " Khong tim thay sheet co ten """ & Tensheet&""",",vbExclamation, Tieude
endsub

Em không hiểu lắm ở phần nhãn Timtiep, cách thức tạo một nhãn như vậy, công dụng anh chị giải đáp giúp em với ạ, e cám ơn
 
Upvote 0
Sub tim_sheet()
Dim Tieude As String
Dim Timduoc As Boolean
Dim I As Integer, sosheet As Long
Dim TenSheet As String
Tieu de = "www.giaiphapexcel.com"
sosheet = ActiveSheet.Sheets.Count 'xac dinh so sheet trong workbook'
timtiep:
Tensheet=lcase(application.inputbox("Ban go ten cua sheet:",Tieude)
If TenSheet = "False" Then Exit Sub 'neu nguoi dung bam cancel
If TenSheet = "" Then
MsgBox "ban hay nhap ten sheet de tim:", vbExclamation, Tieude
GoTo timtiep 'quaytro lai nhan tim tiep
End If
Timduoc = False
For I = 1 To sosheet
If InStr(1, LCase(Sheets(I).Name), TenSheet) > 0 Then
Timduoc = True
Sheets(I).Select
If Msgbox ("Da tim duoc sheet co ten""""&TenSheet&""".Ban cos muon tim tiep khong?",vbYesNo+vbQuestion,Tieude)=vbYes Then Goto Timtiep
Exit For
End If
Next 'Neu khong tim duoc sheet
If Not Timduoc Then
msgbox " Khong tim thay sheet co ten """ & Tensheet&""",",vbExclamation, Tieude
endsub

Em không hiểu lắm ở phần nhãn Timtiep, cách thức tạo một nhãn như vậy, công dụng anh chị giải đáp giúp em với ạ, e cám ơn

Bạn bấm F8 cho duyệt qua từng dòng lệnh khi nào đến chỗ Goto timtiep xong rồi nó nhảy đến đâu thì bạn sẽ hiểu ngay thôi
Như Code trên thì qua Goto Timtiep thì nó sẽ nhảy đến Timtiep:
Sau câu lênh Goto thì bạn có thể đặt 1 tên bất kỳ như Tieptuc, Tiep hoặc gì gì đó (trong code trên là Timtiep)
 
Upvote 0
Bạn bấm F8 cho duyệt qua từng dòng lệnh khi nào đến chỗ Goto timtiep xong rồi nó nhảy đến đâu thì bạn sẽ hiểu ngay thôi
Như Code trên thì qua Goto Timtiep thì nó sẽ nhảy đến Timtiep:
Sau câu lênh Goto thì bạn có thể đặt 1 tên bất kỳ như Tieptuc, Tiep hoặc gì gì đó (trong code trên là Timtiep)
Code này sai. Trước khi giải thích được thì phải hỏi người ta lấy code ở đâu ra.
 
Upvote 0
Các anh chị giúp em sửa lỗi code này với ạ
Mã:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("B5:B" & [C65500].End(xlUp).Row), Target) Is Nothing And Target.Count = 1 Then
            UserForm1.Show
            Cancel = True
    End If
 End Sub
Ví dụ khi em chọn toàn bộ bảng tính hoặc từ hàng nào đó đến hàng cuối cùng hoặc cột nào đó đến cột cuối cùng rồi kích chuột phải thì bị lỗi ạ, em xin cảm ơn
 
Upvote 0
Các anh chị giúp em sửa lỗi code này với ạ
Mã:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("B5:B" & [C65500].End(xlUp).Row), Target) Is Nothing And Target.Count = 1 Then
            UserForm1.Show
            Cancel = True
    End If
End Sub
Ví dụ khi em chọn toàn bộ bảng tính hoặc từ hàng nào đó đến hàng cuối cùng hoặc cột nào đó đến cột cuối cùng rồi kích chuột phải thì bị lỗi ạ, em xin cảm ơn
Vì sự kiện Click phải chuột của bạn chỉ sử hoạt động khi Target=1 và chọn trong cột B( B5-->dòng cuối cùng cột C).
Vì vậy để sử dụng cho nhiều cột bạn thử thay:
PHP:
B5:B
bằng:
PHP:
B5:AB
Lưu ý: Chỉ Click phải chuột vào 1 Cell.
 
Upvote 0
Vì sự kiện Click phải chuột của bạn chỉ sử hoạt động khi Target=1 và chọn trong cột B( B5-->dòng cuối cùng cột C).
Vì vậy để sử dụng cho nhiều cột bạn thử thay:
PHP:
B5:B
bằng:
PHP:
B5:AB
Lưu ý: Chỉ Click phải chuột vào 1 Cell.
Bác hiểu sai câu hỏi của em rồi ạ, em muốn sử dụng cho 1 côt và một cell nên mới khai báo
Range("B5:B" & [C65500].End(xlUp).Row)
Code vẫn chạy ngon lành, chỉ vướng lỗi là khi em chọn toàn bộ bảng tính hoặc từ hàng nào đó đến hàng cuối cùng hoặc cột nào đó đến cột cuối cùng rồi kích chuột phải thì bị lỗi ạ
 

File đính kèm

  • LoiVBA.xlsm
    16.6 KB · Đọc: 5
Upvote 0
Bác hiểu sai câu hỏi của em rồi ạ, em muốn sử dụng cho 1 côt và một cell nên mới khai báo
Range("B5:B" & [C65500].End(xlUp).Row)
Code vẫn chạy ngon lành, chỉ vướng lỗi là khi em chọn toàn bộ bảng tính hoặc từ hàng nào đó đến hàng cuối cùng hoặc cột nào đó đến cột cuối cùng rồi kích chuột phải thì bị lỗi ạ
Bạn thử thêm dòng này vào xem: On Error Resume Next
 
Upvote 0

File đính kèm

  • LoiVBA.xlsm
    18.7 KB · Đọc: 7
Upvote 0
Các anh chị giúp em sửa lỗi code này với ạ
Mã:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("B5:B" & [C65500].End(xlUp).Row), Target) Is Nothing And Target.Count = 1 Then
            UserForm1.Show
            Cancel = True
    End If
End Sub
Ví dụ khi em chọn toàn bộ bảng tính hoặc từ hàng nào đó đến hàng cuối cùng hoặc cột nào đó đến cột cuối cùng rồi kích chuột phải thì bị lỗi ạ, em xin cảm ơn
If Not Intersect(Range("B5:B" & [C65500].End(xlUp).Row), Target) Is Nothing And Target.Rows.Count = 1 Then
 
Upvote 0
Nhờ các anh chị xem giúp:
Trong file khi mình nhập dữ liệu vào cột E thì code chạy
Nhưng khi copy và dán vào thì code không chạy.
Vậy mình phải sửa code như thế nào để code thực hiện lệnh khi copy và dán dữ liệu.
Xin cảm ơn.
 

File đính kèm

  • CONGTHUC.rar
    14.4 KB · Đọc: 14
Upvote 0
Nhờ các anh chị xem giúp:
Trong file khi mình nhập dữ liệu vào cột E thì code chạy
Nhưng khi copy và dán vào thì code không chạy.
Vậy mình phải sửa code như thế nào để code thực hiện lệnh khi copy và dán dữ liệu.
Xin cảm ơn.
Thêm 1 vòng lặp For each sau dòng If Target.Rows.Count = 1 Then nữa là được

Nghĩa là:
Mã:
Dim Clls as Range
If Target.Rows.Count = 1 Then
For Each Clls In Target
.......
Next
End if
 
Upvote 0
Thêm 1 vòng lặp For each sau dòng If Target.Rows.Count = 1 Then nữa là được

Nghĩa là:
Mã:
Dim Clls as Range
If Target.Rows.Count = 1 Then
For Each Clls In Target
.......
Next
End if
[QUOTE="
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Clls As Range
If Target.Column = 5 Then
If Target.Rows.Count = 1 Then
For Each Clls In Target
If Target <> Empty Then
Target.Offset(, 1).Value = "=IF(LEN(DAY(RC[-1]))=1,""0""&TEXT(DAY(RC[-1]),0),TEXT(DAY(RC[-1]),0))"
Target.Offset(, 2).Value = "=IF(LEN(MONTH(RC[-2]))=1,""0""&TEXT(MONTH(RC[-2]),0),TEXT(MONTH(RC[-2]),0))"
Target.Offset(, 3).Value = "=RIGHT(TEXT(YEAR(RC[-3]),0),2)"
Target.Offset(, 4).Value = "=RC[-3]&RC[-2]&RC[-1]"
Else
Target.Offset(, 1) = Empty
Target.Offset(, 2) = Empty
Target.Offset(, 3) = Empty
Target.Offset(, 4) = Empty
Next
End If
End If
End If
End Sub
[/code][/QUOTE]

Mình thêm như vầy nhưng vẫn không được bạn chỉ them cho mình với.
Xin cảm ơn bạn.
 
Lần chỉnh sửa cuối:
Upvote 0
Status
Không mở trả lời sau này.
Web KT
Back
Top Bottom