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

ndu96081631 · 24/9/13

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

siwtom · 4/8/14

ducky2301 đã viết:
Xin các Thầy xem giúp em có cách nào làm cho đoạn code này nó ngắn lại không ?

PHP:

Private Sub CommandButton1_Click() Dim a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y, z a = Worksheets("A").Range("A1048576").End(xlUp).Row - 2 Label22.Caption = a b = Worksheets("B").Range("A1048576").End(xlUp).Row - 2 Label23.Caption = b End Sub

Đây là code của module UserForm?
Nếu bạn có code lặp lại kiểu đó, tức làm những việc như nhau mà chúng chỉ khác nhau "một chút nào đó" - ở đây là tên Sheet và chỉ số của Label - thì bạn phải nghĩ ngay tới vòng lặp. Chính vì thế mà ở bài 1 ta phải học các cấu trúc có trong ngôn ngữ và hiểu được triết lý của chúng. Có như vậy khi gặp vấn đề ta mới biết là cần cấu trúc nào, cấu trúc nào thích hợp nhất.

Ở đây nên dùng vòng For. Vòng lặp Do ... Loop cũng chả sao nhưng rõ ràng ta biết rất rõ có tất cả bao nhiêu vòng lặp - không ít hơn mà cũng không nhiều hơn.

Mã:

Private Sub CommandButton1_Click()
Dim index As Long, curr_row As Long, sum_row As Long
    For index = 65 To 90
        curr_row = Worksheets(Chr(index)).Range("A1048576").End(xlUp).Row - 2
        Controls("Label" & index - 43).Caption = curr_row
        sum_row = sum_row + curr_row
    Next index
    Label48.Caption = sum_row
End Sub

Về khai báo biến nếu nó luôn là Long thì khai báo là Long. Chỉ riêng về bộ nhớ thì Variant chiếm 16 bai trong khi Long chỉ chiếm 4 bai. Variant chỉ khi cần phải thế.

ducky2301 · 4/8/14

siwtom đã viết:
Đây là code của module UserForm?
Nếu bạn có code lặp lại kiểu đó, tức làm những việc như nhau mà chúng chỉ khác nhau "một chút nào đó" - ở đây là tên Sheet và chỉ số của Label - thì bạn phải nghĩ ngay tới vòng lặp. Chính vì thế mà ở bài 1 ta phải học các cấu trúc có trong ngôn ngữ và hiểu được triết lý của chúng. Có như vậy khi gặp vấn đề ta mới biết là cần cấu trúc nào, cấu trúc nào thích hợp nhất.

Ở đây nên dùng vòng For. Vòng lặp Do ... Loop cũng chả sao nhưng rõ ràng ta biết rất rõ có tất cả bao nhiêu vòng lặp - không ít hơn mà cũng không nhiều hơn.

Mã:

Private Sub CommandButton1_Click() Dim index As Long, curr_row As Long, sum_row As Long For index = 65 To 90 curr_row = Worksheets(Chr(index)).Range("A1048576").End(xlUp).Row - 2 Controls("Label" & index - 43).Caption = curr_row sum_row = sum_row + curr_row Next index Label48.Caption = sum_row End Sub

Về khai báo biến nếu nó luôn là Long thì khai báo là Long. Chỉ riêng về bộ nhớ thì Variant chiếm 16 bai trong khi Long chỉ chiếm 4 bai. Variant chỉ khi cần phải thế.

Em cũng nghĩ đến vòng lặp For, nhưng ko biết làm sao cho nó chạy từ A tới Z $-\\/.$ . Nhìn code của Thầy thì em hiểu là trong mã ASCII số 65 là A... hihi %#^#$

. Còn về khai báo biến thì thật tình em ko biết vì em ko có học bài bản VBA mà chỉ học từ những gì cần làm và hỏi các Thầy trên forum thôi /-*+/

. Cám ơn Thầy nhiều lắm @$@!^%

siwtom · 4/8/14

ducky2301 đã viết:
Em cũng nghĩ đến vòng lặp For, nhưng ko biết làm sao cho nó chạy từ A tới Z

Thì phải "xoay xở" một tí, láu cá một tí.

Ví dụ ta gán cho những chữ cái A-Z những số tự nhiên liên tục, vd. từ 1 tới 26 hoặc k tới k+25. Gán bằng cách nào? Vd. bằng cách cho vào mảng. Lúc đó mỗi chữ cái được gán cho 1 số là chỉ số trong mảng của chữ cái đó. Tức khi duyệt các chỉ số thì ta cũng có chữ cái tương ứng.

Vd.

Mã:

Private Sub CommandButton1_Click()
Dim index As Long, curr_row As Long, sum_row As Long, Arr()
    Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
    For index = 0 To UBound(Arr)
        curr_row = Worksheets(Arr(index)).Range("A1048576").End(xlUp).Row - 2
        Controls("Label" & index + 22).Caption = curr_row
        sum_row = sum_row + curr_row
    Next index
    Label48.Caption = sum_row
End Sub

Trong trường hợp khác thì các phần tử trong mảng "kia" có thể là tên (string) các control, tên các sheet ... hoặc là đối tượng (object, vd. các Range) luôn

ducky2301 · 5/8/14

siwtom đã viết:
Thì phải "xoay xở" một tí, láu cá một tí.

Ví dụ ta gán cho những chữ cái A-Z những số tự nhiên liên tục, vd. từ 1 tới 26 hoặc k tới k+25. Gán bằng cách nào? Vd. bằng cách cho vào mảng. Lúc đó mỗi chữ cái được gán cho 1 số là chỉ số trong mảng của chữ cái đó. Tức khi duyệt các chỉ số thì ta cũng có chữ cái tương ứng.

Vd.

Mã:

Private Sub CommandButton1_Click() Dim index As Long, curr_row As Long, sum_row As Long, Arr() Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z") For index = 0 To UBound(Arr) curr_row = Worksheets(Arr(index)).Range("A1048576").End(xlUp).Row - 2 Controls("Label" & index + 22).Caption = curr_row sum_row = sum_row + curr_row Next index Label48.Caption = sum_row End Sub

Trong trường hợp khác thì các phần tử trong mảng "kia" có thể là tên (string) các control, tên các sheet ... hoặc là đối tượng (object, vd. các Range) luôn

_ Tuyệt vời, nếu gán bằng Mảng như thế thì mình có thể đặt tên Sheet = bất kỳ tên gì ko nhất thiết phải mang tính chất liên tục như từ A tới Z đúng ko Thầy.
_ Thầy cho em hỏi, em làm cái code tạo sheet, mà ko biết làm sao cho nó kiểm tra nếu đã có sheet đó rồi thì bỏ qua, tạo tiếp sheet tiếp theo. Thầy giúp em chỉnh cái code này lại nha :

PHP:

Private Sub CommandButton10_Click()
Dim i As Long
Dim sh As WorkSheet
For i = 65 To 90
     For Each sh In ThisWorkbook.Sheets    
            If UCase(sh.Name) = Chr(i) Then    
               Me.CommandButton10.Visible = False    
               Exit Sub    
            End If
     Next

Worksheets.Add(After:=Sheets(Sheets.Count)).Name = Chr(i)
ActiveSheet.Range("A1") = "0" & Chr(i)
ActiveSheet.Range("A2") = "0" & Chr(i)

Next

Worksheets.Add(After:=Sheets(Sheets.Count)).Name = "Number"
ActiveSheet.Range("A1") = "0A"
ActiveSheet.Range("A2") = "0A"

End Sub

_ Làm sao mình short lại thứ tự của các Sheet vậy Thầy ? vd : B - E - F - D - C - A. mình short nó lại thành A- B - C - D - E - F đó.

siwtom · 5/8/14

ducky2301 đã viết:
_ Tuyệt vời, nếu gán bằng Mảng như thế thì mình có thể đặt tên Sheet = bất kỳ tên gì ko nhất thiết phải mang tính chất liên tục như từ A tới Z đúng ko Thầy.

Thế bạn không tự thử được à? Tự thử, mục sở thị thì mới "lên tay" được.

PHP:
_ Thầy cho em hỏi, em làm cái code tạo sheet, mà ko biết làm sao cho nó kiểm tra nếu đã có sheet đó rồi thì bỏ qua, tạo tiếp sheet tiếp theo. Thầy giúp em chỉnh cái code này lại nha :

PHP:

Private Sub CommandButton10_Click() Dim i As Long Dim sh As WorkSheet For i = 65 To 90 For Each sh In ThisWorkbook.Sheets If UCase(sh.Name) = Chr(i) Then Me.CommandButton10.Visible = False Exit Sub End If Next Worksheets.Add(After:=Sheets(Sheets.Count)).Name = Chr(i) ActiveSheet.Range("A1") = "0" & Chr(i) ActiveSheet.Range("A2") = "0" & Chr(i) Next Worksheets.Add(After:=Sheets(Sheets.Count)).Name = "Number" ActiveSheet.Range("A1") = "0A" ActiveSheet.Range("A2") = "0A" End Sub

Mã:

Private Sub CommandButton10_Click()
Dim index As Long, sh As Worksheet, a
    For index = 65 To 90
        On Error Resume Next
        a = Sheets(Chr(index)).[A1].Value
        If Err.Number Then
            Err.Clear
            On Error GoTo 0
            Set sh = Worksheets.Add
            With sh
                .Name = Chr(index)
                .Range("A1").Value = Chr(index)
                .Range("A2").Value = Chr(index)
            End With
        End If
    Next index
    
'    SortSheets
End Sub

_ Làm sao mình short lại thứ tự của các Sheet vậy Thầy ? vd : B - E - F - D - C - A. mình short nó lại thành A- B - C - D - E - F đó.

Giả sử trong cửa sổ chính ta nhìn thấy 3 sheet theo thứ tự B, C, A và thao tác bằng tay ta kéo A lên đầu để các sheet theo thứ tự A, B, C. Bây giờ bạn muốn làm điều đó bằng code? Nếu thế thì: Alt + F11 --> Insert --> Module --> dán code sau vào Module1.

Mã:

Sub SortSheets()
Dim k As Long, n As Long
    For k = Sheets.Count To 2 Step -1
        For n = 1 To k - 1
            If [COLOR=#ff0000]Sheets(n).Name > Sheets(n + 1).Name[/COLOR] Then Sheets(n).Move After:=Sheets(n + 1)
        Next n
    Next k
End Sub

Tất nhiên code trên chỉ làm đúng ý khi vd. tên các sheet là A, B, C, ...
Nếu tên các sheet là vd. Tháng 1, Tháng 2, ..., Tháng 12 thì sau khi chạy code sẽ có thứ tự Tháng 1, Tháng 10, Tháng 11, Tháng 12, Tháng 2, Tháng 3, ..., Tháng 9.
Trong trường hợp trên thì có thể trước khi so sánh 2 chuỗi - dòng đỏ đỏ - thì biến chúng, tức 2 chuỗi so sánh chứ không phải đổi tên 2 sheet, thành dạng Tháng 01, Tháng 02, ..., Tháng 09, Tháng 10, ..., Tháng 12.

Tuy nhiên các trường hợp rất đa dạng. Vd. tên các sheet: T1N2013, ..., T12N2013, T1N2014, ..., T12N2014 thì xử lý thế nào?

Nói chung bạn phải hiểu được thuật toán là so sánh 2 chuỗi để quyết định có đổi chỗ 2 sheet cho nhau không. Hiểu được rồi thì tùy trường hợp mà làm thêm một số thao tác sao cho kết quả so sánh đúng theo ý mình.

ducky2301 · 5/8/14

Thầy siwtom cho em hỏi code này nha. ví dụ em muốn lọc ký tự đầu của 1 cell là số và cho vào sheet Number. Thì em dùng code IsNumeric. Còn nếu là chữ cái A,B,C thì cứ theo đúng tên Sheet đó mà cho vào.
Vậy còn khi ký tự đầu tiên là các ký tự đặc biệt ko phải Số và ABC như : ?-_+=.... thì làm sao phân biệt mấy cái ký tự đặc biệt đó để xóa luôn cái cell đó vậy Thầy ?

PHP:

Private Sub CommandButton10_Click()
Dim index As Long, sh As Worksheet, a
    For index = 65 To 90
        On Error Resume Next
        a = Sheets(Chr(index)).[A1].Value
        If Err.Number Then
            Err.Clear
            On Error GoTo 0
            Set sh = Worksheets.Add
            With sh
                .Name = Chr(index)
                .Range("A1").Value = Chr(index)
                .Range("A2").Value = Chr(index)
            End With
        End If
    Next index
    
'    SortSheets
End Sub

Trong đoạn code trên em thấy Thầy cho "a = Sheets(Chr(index)).[A1].Value" rồi sau đó ko thấy làm gì với cái "a" đó hết ? mục đích để làm gì vậy Thầy ???

siwtom · 5/8/14

ducky2301 đã viết:
Thầy siwtom cho em hỏi code này nha. ví dụ em muốn lọc ký tự đầu của 1 cell là số và cho vào sheet Number. Thì em dùng code IsNumeric. Còn nếu là chữ cái A,B,C thì cứ theo đúng tên Sheet đó mà cho vào.
Vậy còn khi ký tự đầu tiên là các ký tự đặc biệt ko phải Số và ABC như : ?-_+=.... thì làm sao phân biệt mấy cái ký tự đặc biệt đó để xóa luôn cái cell đó vậy Thầy ?

Một ký tự đầu? Bạn đọc ra bằng Left hoặc Mid. Còn kiểm tra? Hàm Asc/AscW(ký tự) sẽ trả về mã của "ký tự". Mã của chữ số là từ 48 tới 57 (tương ứng 0, 1, ..., 9), của A-Z là từ 65 tới 90, của a-z là từ 97 tới 122. Nếu Asc(ký tự) nằm trong mỗi khoảng ở trên thì "ký tự" là chữ số, thuộc A-Z, thuộc a-z
Nếu dùng hàm của system thì có (lâu rồi tôi không nhớ) IsCharAlpha, IsCharAlphaNumeric

PHP:
PHP:

Private Sub CommandButton10_Click() Dim index As Long, sh As Worksheet, a For index = 65 To 90 On Error Resume Next a = Sheets(Chr(index)).[A1].Value If Err.Number Then Err.Clear On Error GoTo 0 Set sh = Worksheets.Add With sh .Name = Chr(index) .Range("A1").Value = Chr(index) .Range("A2").Value = Chr(index) End With End If Next index ' SortSheets End Sub

Trong đoạn code trên em thấy Thầy cho "a = Sheets(Chr(index)).[A1].Value" rồi sau đó ko thấy làm gì với cái "a" đó hết ? mục đích để làm gì vậy Thầy ???

Để thử xem sheet Sheets(Chr(index)) có tồn tại hay không. Nếu không tồn tại thì sẽ có lỗi tại dòng (đọc dữ liệu của sheet không tồn tại)

Mã:

a = Sheets(Chr(index)).[A1].Value

Trước đó có On Error Resume Next mục đích để nếu có lỗi thì còn có cơ hội xử lý. Nếu không có On Error Resume Next mà sẩy ra lỗi thì chỉ còn nước reset/end mà chả giải quyết được gì. Còn có On Error Resume Next thì khi gặp lỗi thì code vẫn chuyển sang dòng tiếp theo. Mà ở dòng tiếp theo thì tôi có code kiểm tra xem có lỗi hay không. Nếu có lỗi - If Err.Number Then thì thực hiện những code có trong If ... End If, tức các code tạo sheet mới. Nếu không có lỗi tức Sheets(Chr(index)) tồn tại thì tất nhiên code trong If ... End If không được thực hiện. Tức sẽ không tạo sheet ... đã có.

Nhiều người dùng object Err để "lờ" lỗi đi, kiểu "trát vôi lên mụn" để che nó đi. Nhưng Err được thiết kế không phải là để "lờ" lỗi đi. Nếu không có Err thì nhiều khi không làm được gì (như trong trường hợp này) hoặc khi gặp lỗi thì phải reset/end code để sửa lại chỗ có lỗi rồi lại phải run code từ đầu. Nếu code rất dài thì bạn hãy tưởng tượng là chạy lại code mất công như thế nào. Trong trường hợp ở trên ta không lờ lỗi đi mà dùng Err để có cơ hội kiểm tra lỗi có sẩy ra hay không để xử lý.

Kiều Mạnh · 5/8/14

Nhờ Chỉnh sửa lại code

Mình có viết một code chạy vòng lập. ghép các dãy số lại vối nhau kết quả ra đúng như mong muốn nhưng tốc độ ghép chậm quá do quá nhiều vòng vòng lập for Next nên tốc độ chậm lại. đó là mình mới cho cột F có khoãng 100 số mà vậy chứ cột F lên 500 => 1000 thì đơ máy luôn.
suy nghĩ mãi không thể viết được cách khác tốc độ tối ưu hơn vì vậy xin úp lên đây nhờ các bạn trợ giúp
Xin cảm ơn

PHP:

Sub Ghep_So()
Dim dauso(), duoiso, kq(), i As Long, j As Long, n As Long
With Sheet4
    duoiso = .Range(.[F3], .[F200].End(4)).Value
    ReDim kq(1 To UBound(duoiso), 1 To 1)
    dauso = .Range("A3:A74").Value
End With
For i = 1 To UBound(duoiso)
    For j = 1 To UBound(dauso)
        If duoiso(i, 1) <> "" Then
            kq(j + n, 1) = dauso(j, 1) & duoiso(i, 1)
        End If
    Next
        n = n + 72
Next
With Sheet4
    .Range("G3:G10000").ClearContents
    .Range("G3").Resize(i - 1, 1) = kq
End With
End Sub

ducky2301 · 5/8/14

siwtom đã viết:
Một ký tự đầu? Bạn đọc ra bằng Left hoặc Mid. Còn kiểm tra? Hàm Asc/AscW(ký tự) sẽ trả về mã của "ký tự". Mã của chữ số là từ 48 tới 57 (tương ứng 0, 1, ..., 9), của A-Z là từ 65 tới 90, của a-z là từ 97 tới 122. Nếu Asc(ký tự) nằm trong mỗi khoảng ở trên thì "ký tự" là chữ số, thuộc A-Z, thuộc a-z
Nếu dùng hàm của system thì có (lâu rồi tôi không nhớ) IsCharAlpha, IsCharAlphaNumeric

Để thử xem sheet Sheets(Chr(index)) có tồn tại hay không. Nếu không tồn tại thì sẽ có lỗi tại dòng (đọc dữ liệu của sheet không tồn tại)

Mã:

a = Sheets(Chr(index)).[A1].Value

Trước đó có On Error Resume Next mục đích để nếu có lỗi thì còn có cơ hội xử lý. Nếu không có On Error Resume Next mà sẩy ra lỗi thì chỉ còn nước reset/end mà chả giải quyết được gì. Còn có On Error Resume Next thì khi gặp lỗi thì code vẫn chuyển sang dòng tiếp theo. Mà ở dòng tiếp theo thì tôi có code kiểm tra xem có lỗi hay không. Nếu có lỗi - If Err.Number Then thì thực hiện những code có trong If ... End If, tức các code tạo sheet mới. Nếu không có lỗi tức Sheets(Chr(index)) tồn tại thì tất nhiên code trong If ... End If không được thực hiện. Tức sẽ không tạo sheet ... đã có.

Nhiều người dùng object Err để "lờ" lỗi đi, kiểu "trát vôi lên mụn" để che nó đi. Nhưng Err được thiết kế không phải là để "lờ" lỗi đi. Nếu không có Err thì nhiều khi không làm được gì (như trong trường hợp này) hoặc khi gặp lỗi thì phải reset/end code để sửa lại chỗ có lỗi rồi lại phải run code từ đầu. Nếu code rất dài thì bạn hãy tưởng tượng là chạy lại code mất công như thế nào. Trong trường hợp ở trên ta không lờ lỗi đi mà dùng Err để có cơ hội kiểm tra lỗi có sẩy ra hay không để xử lý.

_ Cám ơn Thầy nhiều lắm, Thầy giải thích code rất cặn kẽ và dễ hiểu. -=.,,

Quang_Hải · 5/8/14

kieu manh đã viết:
Mình có viết một code chạy vòng lập. ghép các dãy số lại vối nhau kết quả ra đúng như mong muốn nhưng tốc độ ghép chậm quá do quá nhiều vòng vòng lập for Next nên tốc độ chậm lại. đó là mình mới cho cột F có khoãng 100 số mà vậy chứ cột F lên 500 => 1000 thì đơ máy luôn.
suy nghĩ mãi không thể viết được cách khác tốc độ tối ưu hơn vì vậy xin úp lên đây nhờ các bạn trợ giúp
Xin cảm ơn

PHP:

Sub Ghep_So() Dim dauso(), duoiso, kq(), i As Long, j As Long, n As Long With Sheet4 duoiso = .Range(.[F3], .[F200].End(4)).Value ReDim kq(1 To UBound(duoiso), 1 To 1) dauso = .Range("A3:A74").Value End With For i = 1 To UBound(duoiso) For j = 1 To UBound(dauso) If duoiso(i, 1) <> "" Then kq(j + n, 1) = dauso(j, 1) & duoiso(i, 1) End If Next n = n + 72 Next With Sheet4 .Range("G3:G10000").ClearContents .Range("G3").Resize(i - 1, 1) = kq End With End Sub

Bảo đảm mình code chạy trong vòng 1s là ra kết quả. Nhưng giờ đang bận.
Dạng bài này mà không dùng Dic thì chạy tới sáng luôn chưa xong

Kiều Mạnh · 5/8/14

quanghai1969 đã viết:
Bảo đảm mình code chạy trong vòng 1s là ra kết quả. Nhưng giờ đang bận.
Dạng bài này mà không dùng Dic thì chạy tới sáng luôn chưa xong

vậy để em tập set một cái dic xem sao

Quang_Hải · 5/8/14

kieu manh đã viết:
vậy để em tập set một cái dic xem sao

Bài này chỉ khó là khi ghép dãy 6 số để tạo ra những số gần giống chỉ sai duy nhất 1 số gần nhất.
Vừa tạo ra vừa nạp vào Dic để kiểm tra duy nhất luôn. Cuối cùng duyệt qua dữ liệu đầu số nhà mạng và ghép với từng số trong dic
Bảo đảm 10 000 số chạy chưa tới 1s

Kiều Mạnh · 5/8/14

quanghai1969 đã viết:
Bài này chỉ khó là khi ghép dãy 6 số để tạo ra những số gần giống chỉ sai duy nhất 1 số gần nhất.
Vừa tạo ra vừa nạp vào Dic để kiểm tra duy nhất luôn. Cuối cùng duyệt qua dữ liệu đầu số nhà mạng và ghép với từng số trong dic
Bảo đảm 10 000 số chạy chưa tới 1s

không biết em có set nỗi dic không nữa. nhưng cho dù có không ra một kết quả nào đi chăng nữa thì cũng sẽ quyết tâm set một cái dic

Ba Tê · 5/8/14

quanghai1969 đã viết:
Bài này chỉ khó là khi ghép dãy 6 số để tạo ra những số gần giống chỉ sai duy nhất 1 số gần nhất.
Vừa tạo ra vừa nạp vào Dic để kiểm tra duy nhất luôn. Cuối cùng duyệt qua dữ liệu đầu số nhà mạng và ghép với từng số trong dic
Bảo đảm 10 000 số chạy chưa tới 1s

Khó hiểu à nghe!
Code của tác giả bảo là ra kết quả đúng thì tôi đâu thấy có so sánh duy nhất gì đâu mà Dic?

kieu manh đã viết:
Mình có viết một code chạy vòng lập. ghép các dãy số lại vối nhau kết quả ra đúng như mong muốn nhưng tốc độ ghép chậm quá do quá nhiều vòng vòng lập for Next nên tốc độ chậm lại. đó là mình mới cho cột F có khoãng 100 số mà vậy chứ cột F lên 500 => 1000 thì đơ máy luôn.
suy nghĩ mãi không thể viết được cách khác tốc độ tối ưu hơn vì vậy xin úp lên đây nhờ các bạn trợ giúp
Xin cảm ơn

PHP:

Sub Ghep_So() Dim dauso(), duoiso, kq(), i As Long, j As Long, n As Long With Sheet4 duoiso = .Range(.[F3], .[F200].End(4)).Value ReDim kq(1 To UBound(duoiso), 1 To 1) dauso = .Range("A3:A74").Value End With For i = 1 To UBound(duoiso) For j = 1 To UBound(dauso) If duoiso(i, 1) <> "" Then kq(j + n, 1) = dauso(j, 1) & duoiso(i, 1) End If Next n = n + 72 Next With Sheet4 .Range("G3:G10000").ClearContents .Range("G3").Resize(i - 1, 1) = kq End With End Sub

Tôi chạy code này kết quả cũng giống hệt của tác giả, không kịp chớp mắt là xong.
[GPECODE=vb]Public Sub GPE()
Dim Duoi(), Dau(), Arr(), I As Long, J As Long, K As Long
Duoi = Range([F3], [F3].End(xlDown)).Value2
Dau = Range([A3], [A3].End(xlDown)).Value2
ReDim Arr(1 To UBound(Dau, 1) * UBound(Duoi, 1), 1 To 1)
For J = 1 To UBound(Duoi, 1)
For I = 1 To UBound(Dau, 1)
K = K + 1
Arr(K, 1) = Dau(I, 1) & Duoi(J, 1)
Next I
Next J
[H3:H65000].ClearContents
[H3].Resize(K) = Arr
End Sub[/GPECODE]
Hổng biết "ý đồ" dùng Dic để loại ra số nào?

Kiều Mạnh · 5/8/14

Ba Tê đã viết:
Khó hiểu à nghe!
Code của tác giả bảo là ra kết quả đúng thì tôi đâu thấy có so sánh duy nhất gì đâu mà Dic?

Tôi chạy code này kết quả cũng giống hệt của tác giả, không kịp chớp mắt là xong.
[GPECODE=vb]Public Sub GPE()
Dim Duoi(), Dau(), Arr(), I As Long, J As Long, K As Long
Duoi = Range([F3], [F3].End(xlDown)).Value2
Dau = Range([A3], [A3].End(xlDown)).Value2
ReDim Arr(1 To UBound(Dau, 1) * UBound(Duoi, 1), 1 To 1)
For J = 1 To UBound(Duoi, 1)
For I = 1 To UBound(Dau, 1)
K = K + 1
Arr(K, 1) = Dau(I, 1) & Duoi(J, 1)
Next I
Next J
[H3:H65000].ClearContents
[H3].Resize(K) = Arr
End Sub[/GPECODE]
Hổng biết "ý đồ" dùng Dic để loại ra số nào?

Kết quả ra Y trang code em viết mà tốc độ cũng chớp mắt
cảm ơn anh nhiều

Quang_Hải · 5/8/14

Ba Tê đã viết:
Khó hiểu à nghe!
Code của tác giả bảo là ra kết quả đúng thì tôi đâu thấy có so sánh duy nhất gì đâu mà Dic?

Tôi chạy code này kết quả cũng giống hệt của tác giả, không kịp chớp mắt là xong.

Hổng biết "ý đồ" dùng Dic để loại ra số nào?

Không nói hết căn cơ gốc ngọn cho anh nghe đâu. Đâu có cái gì tự nhiên.. ka ka ka

VetMini · 5/8/14

kieu manh đã viết:
Mình có viết một code chạy vòng lập. ghép các dãy số lại vối nhau kết quả ra đúng như mong muốn nhưng tốc độ ghép chậm quá do quá nhiều vòng vòng lập for Next nên tốc độ chậm lại. đó là mình mới cho cột F có khoãng 100 số mà vậy chứ cột F lên 500 => 1000 thì đơ máy luôn.
suy nghĩ mãi không thể viết được cách khác tốc độ tối ưu hơn vì vậy xin úp lên đây nhờ các bạn trợ giúp
Xin cảm ơn

PHP:

Sub Ghep_So() Dim dauso(), duoiso, kq(), i As Long, j As Long, n As Long With Sheet4 duoiso = .Range(.[F3], .[F200].End(4)).Value ReDim kq(1 To UBound(duoiso), 1 To 1) dauso = .Range("A3:A74").Value End With For i = 1 To UBound(duoiso) For j = 1 To UBound(dauso) If duoiso(i, 1) <> "" Then kq(j + n, 1) = dauso(j, 1) & duoiso(i, 1) End If Next n = n + 72 Next With Sheet4 .Range("G3:G10000").ClearContents .Range("G3").Resize(i - 1, 1) = kq End With End Sub

Nếu bạn chịu khó debug, bảo code nó in ra UBound(duoiso) thì sẽ thấy là 1048574. Tính hàng triệu như vậy có máy thánh mới không lâu.
Điều này chứng tỏ code tính ô dữ liệu cuối cùng của bạn sai.
Hãy tự tìm hiểu sai ra sao.

Quang_Hải · 5/8/14

Ba Tê đã viết:
Khó hiểu à nghe!
Code của tác giả bảo là ra kết quả đúng thì tôi đâu thấy có so sánh duy nhất gì đâu mà Dic?
...........
Hổng biết "ý đồ" dùng Dic để loại ra số nào?

Gởi anh BaTê nhà mình cái vụ tại sao phải dùng Dic nha, nếu không anh sẽ ấm ức tại sao em lại nói như thế
Anh có ngon thì đừng dùng Dic nha... hí hí
Yêu Cầu:
1. Cho sẵn dữ liệu tại cột A và cột E
2. Code thế nào để tại cột cột F và G có kết quả như mẫu là I và J

PS: cứ mỗi chuỗi 6 số tạo ra những số chỉ khác nhau 1 số so với chuỗi gốc. Ví dụ 597598 thì sẽ có 4 59758, 6 97598, 587598, ....... tới hết chuỗi
số 9 thì không cộng lên, số 0 thì không trừ xuống.

lhthai · 7/8/14

Hi Cac Anh
Cac Anh có thể giải thích cho em biết nội dung đoạn CODE sau không
Chẳn hạn như đoạn sau số 9 này là gì
Arr(r, 9) = r + 5

Private Sub TextBox9_AfterUpdate()
Dim Arr(), Darr(), i As Long, k As Long, j As Integer, r As Long
Arr = Sheets("nhap").Range("A6:H" & Sheets("nhap").Range("C65536").End(xlUp).Row).Valu e
ReDim Preserve Arr(1 To UBound(Arr, 1), 1 To UBound(Arr, 2) + 1)
For r = 1 To UBound(Arr, 1)
Arr(r, 9) = r + 5
Next r
ReDim Darr(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr, 1)
If Arr(i, 1) = Val(TextBox9.Value) Then
k = k + 1
Darr(k, 1) = Format(Arr(i, 2), "dd/mm/yy")
For j = 2 To UBound(Darr, 2) - 1
Darr(k, j) = Arr(i, j + 1)
Next j
End If
Next i
ListBox1.List = Darr
Sheet2.Range("A1").Resize(UBound(Darr, 1), UBound(Darr, 2)) = Darr
End Sub

ducky2301 · 8/8/14

Xin các Thầy giúp hoàn thiện code vòng lặp này !!!

Em làm 1 cái code vòng lặp tạo ký tự như sau.

PHP:

Sub vlap()
Dim i As Long, j As Long
b = 1
For i = 97 To 122
       For j = 97 To 122
              Activesheet.Range("A" & b).Value = Chr(i) & Chr(j)
              b = b + 1
       Next j
Next i
End Sub

_ Đoan code trên nó sẽ tạo cho em dãy ký tự từ aa -> zz. Giờ em muốn nó có a0 - z9 và 00 - 99 thì em phải thêm cái i = 48 To 57 và j = 48 To 57 vào chỗ nào vậy các Thầy ???.
_ Tóm lại ý em muốn hỏi là làm sao để gắn giá trị i hoặc j = 2 khoảng ko liên tiếp nhau đó (48 To 57 và 97 To 122)

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

Người dùng đang xem chủ đề này

Huyền thoại GPE

Thành viên gắn bó

Thành viên chính thức

Thành viên gắn bó

Thành viên chính thức

Thành viên gắn bó

Thành viên chính thức

Thành viên gắn bó

I don't program, I beat code into submission!!!

File đính kèm

Thành viên chính thức

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

I don't program, I beat code into submission!!!

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

I don't program, I beat code into submission!!!

Cạo Rồi Khỏi Gội

I don't program, I beat code into submission!!!

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

Đang đi tìm hòn đá

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

File đính kèm

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

Thành viên chính thức

Sinh nhật lần 19 GPE