Chuyên mục xử lý, gỡ rối code VBA (4 người xem)

[ndu96081631]

Topic Những câu hỏi về code, xin giải thích các code... đã quá dài nên mình đóng nó lại và mở topic khác
Tất cả những bài viết liên quan đến việc nhờ giải thích, xử lý và gỡ rối code VBA, các bạn vui lòng đăng tại đây!
Cảm ơn

 

[Nguyễn Hồng Quang]

Mình chạy có thấy bị gì đâu

Vậy có thể do máy của em bị lỗi rồi; không phải do file. Cảm ơn anh

 

[vanthinh3101]

Chào các anh, chị , em và các bạn trên GPE
Trong Module1 (ModData), sử dụng code để lấy dữ liệu từ 8 dòng trên Sheet Input đưa sang bên sheet PartsData
Tuy nhiên khi mình kết thúc code bằng lệnh chọn dòng dưới cùng của cột A ở sheet PartsData (như trong hình 1)

Sheets("PartsData").Select
Cells(nextRow, "A").Select

thì Excel lập tức báo lỗi (như trong hình 2)
Mà hễ bình bỏ dòng lệnh đó ra khỏi code thì file lại chạy ngon lành
Mình không hiểu tại sao. Rất mong mọi người giúp đỡ xử lý lỗi này

Code của anh dài nên em luận không ra được.
Em viết code mảng cho ngắn gọn, hi vọng đúng ý của anh.

Sub GPE()
    Dim sArr(), dArr()
    Dim I As Long, j As Long, K As Long, D As Date, lR As Long
    
    D = wksPartsDataEntry.Range("D3")
    sArr() = wksPartsDataEntry.Range("B7", wksPartsDataEntry.Range("B7").End(xlDown)).Resize(, 8).Value
    ReDim dArr(1 To UBound(sArr, 1), 1 To 11)
    
    For I = 1 To UBound(sArr, 1)
        dArr(1, 1) = Format(Now, "mm/dd/yyyy hh:mm:ss")
        dArr(1, 2) = Application.UserName
        K = K + 1
        dArr(K, 3) = D
        For j = 1 To 8
            dArr(K, j + 3) = sArr(I, j)
        Next j
    Next I
    
    lR = wksPartsData.Range("C" & Rows.Count).End(xlUp).Row + 1
    wksPartsData.Range("A" & lR).Resize(K, 11) = dArr
End Sub

 

[thangteo]

Nhờ tất cả mọi người xem qua file và chỉnh sửa code lại theo ý như thế này ạ:
1. Trong form: khi giây chạy về "0:00" thì kêu chuông, hiện tại thì giây chạy về "0:00" nhưng sau 1 giây nó mới kêu chuông. Ý muốn là khi giây nhảy về "0:00" là phải kêu chuông ngay mà không có trễ 1 giây ạ. (bắt đầu chạy là nhấn Enter).
2. Có cách nào để chọn trực tiếp 1 khoảng thời gian bất kỳ ngay trong chỗ thời gian (trong form) để khi nhấn enter thì bắt đầu chạy từ khoảng thời gian bất kỳ đó không ạ, kể cả chỗ hiển thị số Hiệp (trong form) nữa ạ, nếu chọn ngẫu nhiên là Hiệp 2 thì sau khi chạy hết khoảng thời gian ở hiệp đó thì sẽ chuyển sang Hiệp 3 tiếp theo ạ.(ví dụ: thi đấu 3 Hiệp và thời gian thi đấu là 2', tại thời điểm Hiệp 2 đang diễn ra ở 1':25", gặp sự cố mất điện chẳng hạn, sau khi có điện ta chọn lại thời điểm Hiệp 2 và khoảng thời gian 1':25" đó để cho thi đấu tiếp. Yêu cầu là sau khi hết khoảng thời gian đó thì sẽ tiếp tục sang Hiệp 3 và vẫn thời gian thi đấu là 2'. )
----------
Mong sự giúp đỡ của mọi người. File này là anh Huuthang_bd đã làm cho em, vì điều kiện và thời gian chưa cho phép nên anh ấy chưa chỉnh sửa được nên em xin phép anh ấy đăng lên đây để mọi người chỉnh sửa giúp ạ. Cảm ơn mọi người.

 

[duynguyenkk]

Nhờ tất cả mọi người xem code và sữa giúp em với e xuất ra nó không đúng kết quả tổng hợp, với em muốn bỏ nhac chọn vùng dữ liệu ( mặc định là K8: cuối cột P có dữ liệu), và loại bỏ mã ko có đơn vị

Option Explicit

' Dinh nghia kieu nguoi dung cho loai vat tu
' moi loaij vat tu gom co ma so , ten,don vij, khoi luong
Type LoaiVatTu
    Maso As String
    Donvi As String
    Khoiluong As String
End Type

' Lap danh sach cac loai vat tu

Public Sub DanhSachVT()
    Dim R As Range 'Pham vi trong bang vat lieu can phan tich
    Dim DanhSachVT() As LoaiVatTu ' Mang dong chua danhsach vat tu
    Dim i As Long ' chi so mang
    Dim k As Range ' bien nay dung de duyet bang du lieu trong R

Set R = Application.InputBox("Cho?n vu`ng du~ liê?u câ`n tô?ng hop", Type:=8)
    i = 0 'chi so dau tien cua mang vat tu la 0
    Dim ii As Long
    Dim ok As Boolean
    ' Doc du lieu tu sheet "Phan Tich Vat Tu"
    For Each k In R.Columns(1).Cells
        If Trim(k.Value) <> "" Then
            If i = 0 Then 'vat tu dau tien trong danh sach
                ReDim Preserve DanhSachVT(i) 'khai bao lai mang
                'gan du lieu cho vat tu dau tien
                DanhSachVT(i).Maso = Trim(k.Value)
                DanhSachVT(i).Donvi = Trim(k.Offset(0, 6).Value)
                DanhSachVT(i).Khoiluong = Trim(k.Offset(0, 5).Value)
                i = i + 1 'tang chi so mang len 1
            Else 'neu danh sach vat tu lon hon 1
                ok = True
                For ii = 0 To i - 1
                    'vat tu nay da co trong danh sach
                    If DanhSachVT(ii).Maso = Trim(k.Value) Then
                        ok = False
                        DanhSachVT(ii).Khoiluong = DanhSachVT(ii).Khoiluong
                        Exit For
                    End If
                Next ii
                ' vat tu chua co ten trong danh sach
                If ok Then
                    ReDim Preserve DanhSachVT(i)
                    DanhSachVT(i).Maso = Trim(k.Value)
                    DanhSachVT(i).Donvi = Trim(k.Offset(0, 6).Value)
                    DanhSachVT(i).Khoiluong = Trim(k.Offset(0, 5).Value)
                    i = i + 1 'tang chi so mang len 1
                End If
            End If
        End If
    Next
    'Ghi ket qua ra excel, trong sheet "THVT"
    Dim j As Long
    Dim row As Long
 
    row = 7 ' bat dau ghi du lieu
    For j = LBound(DanhSachVT) To UBound(DanhSachVT)
        ThisWorkbook.Worksheets("thvt").Cells(row + j, 1).Value = j + 1
        ThisWorkbook.Worksheets("thvt").Cells(row + j, 2).Value = DanhSachVT(j).Maso
        ThisWorkbook.Worksheets("thvt").Cells(row + j, 3).Value = DanhSachVT(j).Donvi
        ThisWorkbook.Worksheets("thvt").Cells(row + j, 4).Value = DanhSachVT(j).Khoiluong
    Next j
    MsgBox "Ket thuc"
    End Sub

 

[Nguyễn Hồng Quang]

Code của anh dài nên em luận không ra được.
Em viết code mảng cho ngắn gọn, hi vọng đúng ý của anh.

Sub GPE()
    Dim sArr(), dArr()
    Dim I As Long, j As Long, K As Long, D As Date, lR As Long
  
    D = wksPartsDataEntry.Range("D3")
    sArr() = wksPartsDataEntry.Range("B7", wksPartsDataEntry.Range("B7").End(xlDown)).Resize(, 8).Value
    ReDim dArr(1 To UBound(sArr, 1), 1 To 11)
  
    For I = 1 To UBound(sArr, 1)
        dArr(1, 1) = Format(Now, "mm/dd/yyyy hh:mm:ss")
        dArr(1, 2) = Application.UserName
        K = K + 1
        dArr(K, 3) = D
        For j = 1 To 8
            dArr(K, j + 3) = sArr(I, j)
        Next j
    Next I
  
    lR = wksPartsData.Range("C" & Rows.Count).End(xlUp).Row + 1
    wksPartsData.Range("A" & lR).Resize(K, 11) = dArr
End Sub

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; Cảm ơn Vanthinh3101 nhiều, Chúc bạn và gia đình luôn mạnh khỏe, gặp nhiều thành công trong công việc. Hẹn gặp lại bạn mùa hè năm nay nhé

 

[batman1]

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;

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.

 

[VetMini]

Trèo lên mụt đuôi kèo vuốt nhằm con mèo đuôi cụt.

 

[excelbee]

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

 

[batman1]

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

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

 

[VetMini]

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ố

 

[themorzer]

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ị "".

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]

 

[Quy Vu]

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

 

[♫ђöล♥ßล†♥†µ♫]

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)

 

[VetMini]

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.

 

[ThaiDieuAnh]

Các anh chị giúp em sửa lỗi code này với ạ

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

 

[phulien1902]

Các anh chị giúp em sửa lỗi code này với ạ

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:

B5:B

bằng:

B5:AB

Lưu ý: Chỉ Click phải chuột vào 1 Cell.

 

[ThaiDieuAnh]

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:

B5:B

bằng:

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 ạ

 

[♫ђöล♥ßล†♥†µ♫]

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

 

[ThaiDieuAnh]

Bạn thử thêm dòng này vào xem: On Error Resume Next

Thêm dong đó form lại hiện lên bác ạ. Mà thế thì không đúng

 

[♫ђöล♥ßล†♥†µ♫]

Thêm dong đó form lại hiện lên bác ạ. Mà thế thì không đúng

Hay là như vầy nhỉ