Chuyên đề giải đáp những thắc mắc về code VBA (6 người xem)

maytinhvp01 · 31/7/13

Mình muốn nhờ giải thich câu lệnh " If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c) "
trong ví du:
Public Function LonNhat(Ran As Range)
Dim max As Double, v As Integer, d As Integer, c As Integer
max = Ran.Cells(1, 1)
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c)
Next c
Next d
v = Tim(max, Ran)
LonNhat = max
End Function
-------------------------------------------------------
[INFO1]Thông báo:
Vì topic này:
http://www.giaiphapexcel.com/forum/...ải-thích-các-code-đề-nghị-các-bạn-gửi-vào-đây
đã quá dài nên BQT đóng lại.
Nay tôi mở topic mới với cùng chủ đề: GIẢI THÍCH NHỮNG THẮC MẮC VỀ CODE
Các bạn nếu có nhu cầu giải thích code, vui lòng post tại đây nhé
NDU96081631
[/INFO1]

Kiều Mạnh · 25/4/20

Các bạn cho mình hỏi chút Hàm Application.Transpose(Cells) bị giới hạn khi chuyển 255 ký tự trên 1 Cells
vậy có cách nào khác viết Hàm tự tạo chuyển mãng trên 300 ký tự/1 Cells ko nhỉ

VetMini · 25/4/20

kieu manh đã viết:
Các bạn cho mình hỏi chút Hàm Application.Transpose(Cells) bị giới hạn khi chuyển 255 ký tự trên 1 Cells
vậy có cách nào khác viết Hàm tự tạo chuyển mãng trên 300 ký tự/1 Cells ko nhỉ

Viết một hàm chuyển mảng cột thành dòng, dòng thành cột.
Hàm nhận một Variant. Xét type của Variant đó, nếu là Range thì chuyển thành mảng.
Hàm trả về một mảng là transpose của mảng đầu vào.

Đại khái code chuyển dòng thành cột, từ mảng a sang mảng b:
rowLo = LBound(a)
rowHi = UBound(a)
colLo = LBound(a, 2)
colHi = UBound(a, 2)
For i = rowILo To rowHi
For j = colLo To colHi
b(j, i) = a(i, j)
Next j
Next i
Nếu mảng rất lớn thì có thể cải tiến tốc đọ bằng cách duyệt cột vòng ngài, dòng vòng trong.
(tôi nhớ có người từng chứng minh rằng VBA dùng cấu trúc mảng xoay theo cột, tức là xoay theo chiều cuối cùng. Nếu đúng vậy thì duyệt cột nhanh hơn dòng. Nhưng nếu tôi nhớ lầm thì xin lỗi mọi người, lầm thôi. Bi giờ lười lục lại bài ấy để xem quá)

Kiều Mạnh · 25/4/20

VetMini đã viết:
Viết một hàm chuyển mảng cột thành dòng, dòng thành cột.
Hàm nhận một Variant. Xét type của Variant đó, nếu là Range thì chuyển thành mảng.
Hàm trả về một mảng là transpose của mảng đầu vào.

Đại khái code chuyển dòng thành cột, từ mảng a sang mảng b:
rowLo = LBound(a)
rowHi = UBound(a)
colLo = LBound(a, 2)
colHi = UBound(a, 2)
For i = rowILo To rowHi
For j = colLo To colHi
b(j, i) = a(i, j)
Next j
Next i
Nếu mảng rất lớn thì có thể cải tiến tốc đọ bằng cách duyệt cột vòng ngài, dòng vòng trong.
(tôi nhớ có người từng chứng minh rằng VBA dùng cấu trúc mảng xoay theo cột, tức là xoay theo chiều cuối cùng. Nếu đúng vậy thì duyệt cột nhanh hơn dòng. Nhưng nếu tôi nhớ lầm thì xin lỗi mọi người, lầm thôi. Bi giờ lười lục lại bài ấy để xem quá)

Mới hỏi xong thì mò Google 1 chút cũng ra cách này ...
Cho Mạnh mở rộng hỏi thêm chút là có cách nào nhanh nhất tăng tốc chuyển một Mảng ADO rất lớn không ... ý hỏi Tốc độ nhanh nhất có thể ấy
VD: cùng dữ liệu như nhau mà cái nào về trước thì nó ok ... còn lại không quan tâm cách gì !

Mã:

Sub Transpose_Data()
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    '.....
    Set rs = cn.Execute(srtQry)
    tmpArray = rs.GetRows
    cn.Close
    tmpArray2 = transposeArray(tmpArray)
End Sub

Viết cái Hàm transposeArray chạy nhanh nhất có thể

VetMini · 25/4/20

kieu manh đã viết:
...Viết cái Hàm transposeArray chạy nhanh nhất có thể

Nếu bạn không cần gọi hàm trên bảng tính thì viết cái sub nhanh hơn
Sub XoayMang(a(), b())
' sub xoay mảng (transpose) a qua b
code bài #2449 ở đây (tuy nhiên, tôi không bảo đảm nó "nhanh nhất")
quan trọng: code bài #2449 tự cho rằng hai mảng a và b có LBound giống nhau
End Sub
Code gọi sub tự mình dựng cái mảng b và chuyển cho sub để nhận kết quả.
Lưu ý: với sub này, b có thể lớn hơn a. Nếu b lớn hơn a thì nó sẽ giữ lại các trị bên ngoài a.
Nếu muốn b có thể nhỏ hơn a thì viết thêm code giới hạn: Max cột là Min của dòng a và cột b; Min dòng là Min của cột a và dòng b

Nếu phải gọi hàm trên bảng tính thì viết cái hàm gọi sub này. Tuy nhiên, hàm phải qua mọt giai đoạn copy mảng cho nên chậm hơn (một vài phần ngàn giây).
Function TransposeArray(a())
Dim b()
Redim b(LBound(a, 2) To UBound(a, 2), LBound(a, 1) To UBound(a, 1))
XoayMang(a, b)
TransposeArray = b
End Function

Kiều Mạnh · 25/4/20

VetMini đã viết:
Nếu bạn không cần gọi hàm trên bảng tính thì viết cái sub nhanh hơn
Sub XoayMang(a(), b())
' sub xoay mảng (transpose) a qua b
code bài #2449 ở đây (tuy nhiên, tôi không bảo đảm nó "nhanh nhất")
quan trọng: code bài #2449 tự cho rằng hai mảng a và b có LBound giống nhau
End Sub
Code gọi sub tự mình dựng cái mảng b và chuyển cho sub để nhận kết quả.
Lưu ý: với sub này, b có thể lớn hơn a. Nếu b lớn hơn a thì nó sẽ giữ lại các trị bên ngoài a.
Nếu muốn b có thể nhỏ hơn a thì viết thêm code giới hạn: Max cột là Min của dòng a và cột b; Min dòng là Min của cột a và dòng b

Nếu phải gọi hàm trên bảng tính thì viết cái hàm gọi sub này. Tuy nhiên, hàm phải qua mọt giai đoạn copy mảng cho nên chậm hơn (một vài phần ngàn giây).
Function TransposeArray(a())
Dim b()
Redim b(LBound(a, 2) To UBound(a, 2), LBound(a, 1) To UBound(a, 1))
XoayMang(a, b)
TransposeArray = b
End Function

Mai rảnh thử viết kiểu Sub xem Sao ... chuyển từ mảng A sang B

Mã:

Public Sub TransposeArr(ByRef A() As Variant, ByRef B() As Variant)
''............
''............
End Sub

batman1 · 25/4/20

VetMini đã viết:
Nếu mảng rất lớn thì có thể cải tiến tốc đọ bằng cách duyệt cột vòng ngài, dòng vòng trong.
(tôi nhớ có người từng chứng minh rằng VBA dùng cấu trúc mảng xoay theo cột, tức là xoay theo chiều cuối cùng. Nếu đúng vậy thì duyệt cột nhanh hơn dòng. Nhưng nếu tôi nhớ lầm thì xin lỗi mọi người, lầm thôi. Bi giờ lười lục lại bài ấy để xem quá)

Delphi ghi mảng theo từng dòng, VBA ghi theo từng cột. Vì thế có thể thay vì duyệt từng ô của cột thì dùng CopyMemory (hàm API) để copy trong 1 nốt nhạc. Nhưng nếu là mảng các Variant (String) thì để viết chuẩn không phải dễ. Vì rất dễ rò rỉ bộ nhớ, code không chuẩn.

Ngày xưa siwtom cũng từng tham gia chủ đề của Nguyễn Duy Tuân. Đại khái cứ tìm với từ khóa "modFastArray" là ra.

Kiều Mạnh · 25/4/20

batman1 đã viết:
Delphi ghi mảng theo từng dòng, VBA ghi theo từng cột. Vì thế có thể thay vì duyệt từng ô của cột thì dùng CopyMemory (hàm API) để copy trong 1 nốt nhạc. Nhưng nếu là mảng các Variant (String) thì để viết chuẩn không phải dễ. Vì rất dễ rò rỉ bộ nhớ, code không chuẩn.

Ngày xưa siwtom cũng từng tham gia chủ đề của Nguyễn Duy Tuân. Đại khái cứ tìm với từ khóa "modFastArray" là ra.

Bài đó em đọc tới nhiều nhiều rồi ... hôm thớt @thuyyeu99 có hỏi anh cũng có giải thích ... Em cũng đọc tới lui rồi mà nó cứ như gà mắc tắc vậy
Anh cho Em xin 1 code đơn giản nhất như 1+1=2 đi em hình dung ra xong mới học được
cảm ơn Anh

batman1 · 25/4/20

kieu manh đã viết:
Bài đó em đọc tới nhiều nhiều rồi ... hôm thớt @thuyyeu99 có hỏi anh cũng có giải thích ... Em cũng đọc tới lui rồi mà nó cứ như gà mắc tắc vậy
Anh cho Em xin 1 code đơn giản nhất như 1+1=2 đi em hình dung ra xong mới học được
cảm ơn Anh

Tôi chỉ đoán ý bác VetMini và nghĩ đang nói tới "cái này" thôi. Còn chuyện áp dụng vào vấn đề của bạn, và có áp dụng được không, thì tôi không có ý kiến. Tôi không tham gia chủ đề xoay mảng của bạn. Chỉ là bình luận bên lề bài của bác VetMini thôi.

Kiều Mạnh · 26/4/20

sử dụng Hàm API CopyMemory Tốc độ nhanh thật ... Nghiên cứu cái vụ chuyển mảng nếu thành công thì quá tốt

VB Helper: HowTo: Remove an item from the middle of an array quickly

www.vb-helper.com

Nó ứng dụng nhiều thứ đấy chứ nhỉ

Mã:

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Function JoinIt(stringArray() As String, sJoinChars As String) As String
    Dim lJoinLen As Long, lSize As Long
    Dim joinPtr As Long, newStrPtr As Long
    Dim Z As Long
    
    lJoinLen = LenB(sJoinChars)
    ' count first
    For Z = 0 To UBound(stringArray)
       lSize = lSize + LenB(stringArray(Z))
    Next
    JoinIt = String$((lSize + (UBound(stringArray) * lJoinLen)) \ 2, vbNullChar)
    If LenB(JoinIt) Then
         newStrPtr = StrPtr(JoinIt)
         joinPtr = StrPtr(sJoinChars)
         ' transfer
         For Z = 0 To UBound(stringArray) - 1
             lSize = LenB(stringArray(Z))
             If lSize Then
                 CopyMemory ByVal newStrPtr, ByVal StrPtr(stringArray(Z)), lSize
                 newStrPtr = newStrPtr + lSize
             End If
             If lJoinLen Then
                 CopyMemory ByVal newStrPtr, ByVal joinPtr, lJoinLen
                 newStrPtr = newStrPtr + lJoinLen
             End If
         Next
         ' handle last array item separately, no join char appended
         lSize = LenB(stringArray(Z))
         If lSize Then CopyMemory ByVal newStrPtr, ByVal StrPtr(stringArray(Z)), lSize
    End If
End Function

Private Sub Command1_Click()
    Dim s(0 To 25) As String
    Dim v As Long
    For v = 1 To 26
        s(v - 1) = Chr$(v + 64)
    Next
    Debug.Print JoinIt(s(), "(:)")
End Sub

VetMini · 26/4/20

memmove, memcpy, memset, và memcmp là 4 hàm macro căn bản của C viết bằng mã máy và rất ưu việt. Bởi vì chúng hoạt động trên cả vùng nhớ xác định và liên tục.
Tôi không dùng COM và API nhiều nhưng không lấy làm lạ khi mấy hàm này được MS đưa vào API's

Sử dụng chúng thì có mấy điểm sau đây cần lưu ý:
1. mảng là một vùng nhớ liên tục, không chấp nhận chuyện đứt quãng.
2. C là ngôn ngữ hoạt động mạnh nhất khì sử dụng con trỏ. Vì vậy các hàm này được viết với người sử dụng con trỏ là mục đích.
3. hai tính chất trên cũng xác định rằng bước vào vùng nhớ của mảng thì không còn khái niệm dòng cột gì cả. Việc xác định phần tử dòng nào, cột nào thuộc về code gọi hàm.

Tính chất 2 ở trên là điểm mà các bạnn chưa quen với con trỏ cần để ý.
Mảng Variant là mảng chỉ có địa chỉ (tức các con trỏ) của các phần tử được chứa trong mảng. Trị của từng phần tử được chứa nơi khác. Khi đụng vào loại mảng này, quý vị phải coi chừng bị rò rỉ bộ nhớ. Bộ phận dọn rác (garbage collector) cảu VBA chỉ dọn theo tính chất biến mà nó biết. Bạn thay đổi con trỏ tầng thứ nhì (secondary reference) vào chỗ khác hoặc thay đổi kích thước vùng nhớ bằng cách đi vòng thì chưa chắc VBA biết. Và dẫn đến việc rò rỉ bộ nhớ (memory leak, chương trình hoặc hệ thống bị đứng) hoặc tệ hơn bị chồng vùng nhớ (memory overlap, dữ liệu bị sai).
Điều này bạn "bờ mờ số một" đã cảnh báo quý vị mỗi khi nhắc đến mấy cái hàm mem's này.

Hoàng Nhật Phương · 28/4/20

Xin chào các Bạn,
Giả thiết OT tạo module đặt tên là "KhaiBao"

Trong modude khai Báo OT có nhiều dòng
Public Const ....

Nếu có 2 biến trùng nhau, ví dụ:
Public Const sName As String = "OT"
....
Public Const sName As String = "Oanh_Tho"

Vậy có cách nào để mình biết được việc khai báo trùng này không ạ?

phihndhsp · 28/4/20

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào các Bạn,
Giả thiết OT tạo module đặt tên là "KhaiBao"

Trong modude khai Báo OT có nhiều dòng
Public Const ....

Nếu có 2 biến trùng nhau, ví dụ:
Public Const sName As String = "OT"
....
Public Const sName As String = "Oanh_Tho"

Vậy có cách nào để mình biết được việc khai báo trùng này không ạ?

Bạn thử chạy chương trình xem nó có báo lỗi chỗ khai báo không? Làm gì có khai báo 2 lần trong một sub

befaint · 28/4/20

Nguyễn Hoàng Oanh Thơ đã viết:
biết được

Luôn luôn chạy cái này để kiểm tra... code đã viết.

Kiều Mạnh · 28/4/20

befaint đã viết:
Luôn luôn chạy cái này để kiểm tra... code đã viết.

View attachment 236582

Nên làm thế là hay nhất

Hoàng Nhật Phương · 28/4/20

befaint đã viết:
Luôn luôn chạy cái này để kiểm tra... code đã viết.

View attachment 236582

Đúng là cái này rồi ạ nó có thể kiểm soát việc trùng tên Sub hoặc Function,xin cảm ơn befaint

kokano90 · 4/5/20

Nhờ các thầy cô coi giúp em đoạn code dưới đây sai ở đoạn nào với ạ

Mã:

Sub Tach_sheet()
    Dim i%, LR%, Rng As Range, Cll As Range
On Error Resume Next
Set Rng = Application.InputBox("Quet vung chon:", "Thong bao", Type:=8)
For Each Cll In Rng
    If ActiveSheet.Name = Cll.Value Then
        Exit For
    Else
        Sheet2.Copy after:=Sheets(Sheets.Count)
        ActiveSheet.Name = Cll.Value
    End If
Next Cll
End Sub

Mục đích là em muốn copy sheet mẫu và đặt tên sheet được tạo theo giá trị của vùng được chọn.
Nhưng có 1 bất cập là. Chẳng hạn vùng chọn có những giá trị trùng với tên sheet rồi thì bỏ qua. Không tạo thêm nữa mà loay hoay mãi tới giờ chưa ra.
Mong mọi người chỉ giúp với ạ

CHAOQUAY · 4/5/20

kokano90 đã viết:
Nhờ các thầy cô coi giúp em đoạn code dưới đây sai ở đoạn nào với ạ

Mã:

Sub Tach_sheet() Dim i%, LR%, Rng As Range, Cll As Range On Error Resume Next Set Rng = Application.InputBox("Quet vung chon:", "Thong bao", Type:=8) For Each Cll In Rng If ActiveSheet.Name = Cll.Value Then Exit For Else Sheet2.Copy after:=Sheets(Sheets.Count) ActiveSheet.Name = Cll.Value End If Next Cll End Sub

Mục đích là em muốn copy sheet mẫu và đặt tên sheet được tạo theo giá trị của vùng được chọn.
Nhưng có 1 bất cập là. Chẳng hạn vùng chọn có những giá trị trùng với tên sheet rồi thì bỏ qua. Không tạo thêm nữa mà loay hoay mãi tới giờ chưa ra.
Mong mọi người chỉ giúp với ạ

Chạy thử code dưới.

Mã:

Sub Tach_sheet()
    Dim i%, LR%, Rng As Range, Cll As Range
'On Error Resume Next
Set Rng = Application.InputBox("Quet vung chon:", "Thong bao", Type:=8)
For Each Cll In Rng
    'If ActiveSheet.Name = Cll.Value Then
    If ActiveSheet.Name <> Cll.Value Then
        'Exit For
    'Else
        Sheet2.Copy after:=Sheets(Sheets.Count)
        ActiveSheet.Name = Cll.Value
    End If
Next Cll
End Sub

kokano90 · 4/5/20

CHAOQUAY đã viết:

Chạy thử code dưới.

Mã:

Sub Tach_sheet()
    Dim i%, LR%, Rng As Range, Cll As Range
'On Error Resume Next
Set Rng = Application.InputBox("Quet vung chon:", "Thong bao", Type:=8)
For Each Cll In Rng
    'If ActiveSheet.Name = Cll.Value Then
    If ActiveSheet.Name <> Cll.Value Then
        'Exit For
    'Else
        Sheet2.Copy after:=Sheets(Sheets.Count)
        ActiveSheet.Name = Cll.Value
    End If
Next Cll
End Sub

Cám ơn thầy ạ. Nếu trường hợp nó có tên trùng với vùng chọn rồi. Thì nó báo lỗi. Mà em chưa biết phải làm thế nào.
Ý muốn là nếu có tên rồi thì sẽ bỏ qua. không tạo nữa.
Phiền thầy và mọi người giúp đỡ ạ.

snow25 · 4/5/20

kokano90 đã viết:
View attachment 236819
Cám ơn thầy ạ. Nếu trường hợp nó có tên trùng với vùng chọn rồi. Thì nó báo lỗi. Mà em chưa biết phải làm thế nào.
Ý muốn là nếu có tên rồi thì sẽ bỏ qua. không tạo nữa.
Phiền thầy và mọi người giúp đỡ ạ.

Thử.

Mã:

Sub Tach_sheet()
    Dim i%, LR%, Rng As Range, Cll As Range, sh As Worksheet, s As String
    s = "#"
Set Rng = Application.InputBox("Quet vung chon:", "Thong bao", Type:=8)
For Each sh In ThisWorkbook.Worksheets
    s = s & UCase(sh.Name) & "#"
Next
For Each Cll In Rng
    If InStr(1, s, "#" & UCase(Cll.Value) & "#") = 0 Then
        Sheet2.Copy after:=Sheets(Sheets.Count)
        ActiveSheet.Name = Cll.Value
    End If
Next Cll
End Sub

CHAOQUAY · 4/5/20

kokano90 đã viết:
View attachment 236819
Cám ơn thầy ạ. Nếu trường hợp nó có tên trùng với vùng chọn rồi. Thì nó báo lỗi. Mà em chưa biết phải làm thế nào.
Ý muốn là nếu có tên rồi thì sẽ bỏ qua. không tạo nữa.
Phiền thầy và mọi người giúp đỡ ạ.

Thử 1 lần nữa

Mã:

Sub Tach_sheet()
Dim i%, LR%, Rng As Range, Cll As Range
Dim t As Variant
Set Rng = Application.InputBox("Quet vung chon:", "Thong bao", Type:=8)
With CreateObject("Scripting.Dictionary")
    For Each Cll In Rng
        If Trim(Cll) <> "" Then .Item(Trim(Cll)) = ""
    Next Cll
    'For Each t In ActiveWorkbook.Names
    '    If .exists(t) Then .Remove t
    'Next t

    For Each t In Worksheets
        If .exists(t.Name) Then .Remove t.Name
    Next t
    For Each t In .keys
        Sheet2.Copy after:=Sheets(Sheets.Count)
        ActiveSheet.Name = t
    Next t
End With
End Sub

kokano90 · 4/5/20

Cám ơn anh @snow25 và @CHAOQUAY nhiều nhiều ạ. Code của anh @snow25 thấy chạy ổn ạ
Code anh @CHAOQUAY không hiểu sao nó báo lỗi như hình ảnh trên ạ.

Có điều em chưa hiểu lắm đoạn

Mã:

For Each t In ActiveWorkbook.Names
        If .exists(t) Then .remove t
    Next t

Tức là duyệt qua tên của từng sheet. nếu cái nào trùng trong key thì loại bỏ ạ.
Nếu anh có thời gian. có thể bớt chút thời gian chỉ cho em hiểu với ạ

CHAOQUAY · 4/5/20

kokano90 đã viết:
Cám ơn anh @snow25 và @CHAOQUAY nhiều nhiều ạ. Code của anh @snow25 thấy chạy ổn ạ
Code anh @CHAOQUAY không hiểu sao nó báo lỗi như hình ảnh trên ạ.View attachment 236828
Có điều em chưa hiểu lắm đoạn

Mã:

For Each t In ActiveWorkbook.Names If .exists(t) Then .remove t Next t

Tức là duyệt qua tên của từng sheet. nếu cái nào trùng trong key thì loại bỏ ạ.
Nếu anh có thời gian. có thể bớt chút thời gian chỉ cho em hiểu với ạ

Sửa lại bên dưới.

Mã:

Sub A_Tach_sheet()
Dim i%, LR%, Rng As Range, Cll As Range
Dim t As Variant
Set Rng = Application.InputBox("Quet vung chon:", "Thong bao", Type:=8)
With CreateObject("Scripting.Dictionary")
    For Each Cll In Rng
        If Trim(Cll) <> "" Then .Item(Trim(Cll)) = ""
    Next Cll
    For Each t In Worksheets
        If .exists(t.Name) Then .Remove t.Name
    Next t
    If .Count Then
        For Each t In .keys
            Sheet2.Copy after:=Sheets(Sheets.Count)
            ActiveSheet.Name = t
        Next t
    End If
End With
End Sub

---

Mã:

For Each t In ActiveWorkbook.Names
        If .exists(t) Then .remove t
    Next t

"Tức là duyệt qua tên của từng sheet. nếu cái nào trùng trong key thì loại bỏ ạ."

Đúng là phải thực hiện bước này.
Ý định là như vậy nhưng viết không đúng. Phải sửa lại for each t in worksheets như trên.
Workbook.Names là name người dùng, không phải tên sheet nên không đúng.

PacificPR · 4/5/20

kokano90 đã viết:
Cám ơn anh @snow25 và @CHAOQUAY nhiều nhiều ạ. Code của anh @snow25 thấy chạy ổn ạ
Code anh @CHAOQUAY không hiểu sao nó báo lỗi như hình ảnh trên ạ.View attachment 236828
Có điều em chưa hiểu lắm đoạn

Mã:

For Each t In ActiveWorkbook.Names If .exists(t) Then .remove t Next t

Tức là duyệt qua tên của từng sheet. nếu cái nào trùng trong key thì loại bỏ ạ.
Nếu anh có thời gian. có thể bớt chút thời gian chỉ cho em hiểu với ạ

Bon chen 1 tý. Bạn tham khảo thêm nhé

Mã:

Sub Tach_sheet()
    Dim Rng As Range, Cll As Range
On Error GoTo Handle
Set Rng = Application.InputBox("Quet vung chon:", "Thong bao", Type:=8)
For Each Cll In Rng
    If Not WsExit(Cll.Value) Then
        Sheet2.Copy after:=Sheets(Sheets.Count)
        Worksheets(Worksheets.Count).Name = Cll.Value       
    End If
Next Cll
Handle:
End Sub
Function WsExit(wsName As String) As Boolean
    On Error Resume Next
    WsExit = CBool(Len(Worksheets(wsName).Name) > 0)
End Function

kokano90 · 6/5/20

Em chào các thầy cô ạ.
Em có 1 file gồm 3 sheet:
DATA: chứa dữ liệu
DULEU: Là nơi chứa dữ liệu lọc trùng theo số hóa đơn từ sheet DATA
Form: để in dữ liệu từ số hóa đơn

Em có viết 1 đoạn code:

Mã:

Sub ABC()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim iRow&, sWS As Worksheet, sArr(), KQ(), iC&, a&, b&, rC&, WF As Object
    Dim i&, j&, dC&, Arr(), ans&, WS As Worksheet, dWS As Worksheet
    Set WF = Application.WorksheetFunction
    Set WS = Sheets("Form"): Set sWS = Sheets("DATA"): Set dWS = Sheets("DULIEU")
        iRow = sWS.Range("E" & Rows.Count).End(xlUp).Row
        dC = dWS.Range("D" & Rows.Count).End(xlUp).Row
        Arr = dWS.Range("A3:F" & dC).Value
        sArr = sWS.Range("A15:T" & iRow).Value2
        ReDim KQ(1 To UBound(sArr, 1), 1 To 6)
        WS.Range("A8:F10000").Delete
            For i = 1 To UBound(Arr)
                WS.Range("D1").Value = UCase(Arr(i, 4))
                WS.Range("D2").Value = UCase(Arr(i, 5))
                WS.Range("D3").Value = UCase(Arr(i, 3))
                WS.Range("A6").Value = dWS.Range("I1").Value & _
                Arr(i, 1) & "/" & Day(Arr(i, 2)) & Month(Arr(i, 2)) & _
                Year(Arr(i, 2)) & " KH: YT/18P"
                For iC = 1 To UBound(sArr)
                    If sArr(iC, 5) = Arr(i, 1) Then
                    a = a + 1
                    KQ(a, 1) = a
                    KQ(a, 2) = sArr(iC, 11)
                    KQ(a, 3) = sArr(iC, 12)
                    KQ(a, 4) = sArr(iC, 13)
                    KQ(a, 5) = sArr(iC, 14)
                    KQ(a, 6) = sArr(iC, 15)
                    End If
                Next iC
                With WS
                If a Then .Range("A8:F8").Resize(a).Value = KQ
                .Range("A7:F7").Resize(a + 1).Borders.LineStyle = 1
                rC = .Range("A" & Rows.Count).End(xlUp).Row
                dWS.Range("I2:N9").Copy .Range("A" & rC)
                .PrintPreview
                End With
                a = 0: KQ = Empty
            Next i
    MsgBox ("da xong")
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

như file đính kèm
Nhưng không hiểu sao cứ tới lúc bắt đầu vào vòng lặp

Mã:

For i = 1 To UBound(Arr)

này trở đi thì nó lại bị hiện tượng treo máy.
Nhờ các thầy cô có thể giải thích giúp em được không ạ. Hoặc có cách nào hay hơn nhờ thầy cô giúp với ạ.
Em xin cám ơn

panda1112009 · 6/5/20

Em có đoạn code ntn.. và e muốn khi chạy đoạn mã này nó sẽ hiện ra 1 ô thông báo để mình chọn số đơn vị muốn làm tròn cd: 3;0;-3. Vì trong code này nó mặc định bằng 0 nên nhiều lúc phải chỉnh tay khá mất công.. e xin cảm ơn ạ.

Public Sub ChenRound()
Dim Vung, Cll, Tam
Set Vung = Application.InputBox("Nhap vung muon chen ham ROUND", , , , , , , 8)
For Each Cll In Vung
Tam = Replace(Cll.Formula, "=", "")
Cll.Formula = "=ROUND(" & Tam & ",0)"
Next Cll
End Sub

khuyenbachmao · 13/5/20

kokano90 đã viết:

Em chào các thầy cô ạ.
Em có 1 file gồm 3 sheet:
DATA: chứa dữ liệu
DULEU: Là nơi chứa dữ liệu lọc trùng theo số hóa đơn từ sheet DATA
Form: để in dữ liệu từ số hóa đơn

Em có viết 1 đoạn code:

Mã:

Sub ABC()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim iRow&, sWS As Worksheet, sArr(), KQ(), iC&, a&, b&, rC&, WF As Object
    Dim i&, j&, dC&, Arr(), ans&, WS As Worksheet, dWS As Worksheet
    Set WF = Application.WorksheetFunction
    Set WS = Sheets("Form"): Set sWS = Sheets("DATA"): Set dWS = Sheets("DULIEU")
        iRow = sWS.Range("E" & Rows.Count).End(xlUp).Row
        dC = dWS.Range("D" & Rows.Count).End(xlUp).Row
        Arr = dWS.Range("A3:F" & dC).Value
        sArr = sWS.Range("A15:T" & iRow).Value2
        ReDim KQ(1 To UBound(sArr, 1), 1 To 6)
        WS.Range("A8:F10000").Delete
            For i = 1 To UBound(Arr)
                WS.Range("D1").Value = UCase(Arr(i, 4))
                WS.Range("D2").Value = UCase(Arr(i, 5))
                WS.Range("D3").Value = UCase(Arr(i, 3))
                WS.Range("A6").Value = dWS.Range("I1").Value & _
                Arr(i, 1) & "/" & Day(Arr(i, 2)) & Month(Arr(i, 2)) & _
                Year(Arr(i, 2)) & " KH: YT/18P"
                For iC = 1 To UBound(sArr)
                    If sArr(iC, 5) = Arr(i, 1) Then
                    a = a + 1
                    KQ(a, 1) = a
                    KQ(a, 2) = sArr(iC, 11)
                    KQ(a, 3) = sArr(iC, 12)
                    KQ(a, 4) = sArr(iC, 13)
                    KQ(a, 5) = sArr(iC, 14)
                    KQ(a, 6) = sArr(iC, 15)
                    End If
                Next iC
                With WS
                If a Then .Range("A8:F8").Resize(a).Value = KQ
                .Range("A7:F7").Resize(a + 1).Borders.LineStyle = 1
                rC = .Range("A" & Rows.Count).End(xlUp).Row
                dWS.Range("I2:N9").Copy .Range("A" & rC)
                .PrintPreview
                End With
                a = 0: KQ = Empty
            Next i
    MsgBox ("da xong")
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

như file đính kèm
Nhưng không hiểu sao cứ tới lúc bắt đầu vào vòng lặp

Mã:

For i = 1 To UBound(Arr)

này trở đi thì nó lại bị hiện tượng treo máy.
Nhờ các thầy cô có thể giải thích giúp em được không ạ. Hoặc có cách nào hay hơn nhờ thầy cô giúp với ạ.
Em xin cám ơn

Mình có một số góp ý tiến trình xử lý tiện nhất:

Thứ tự thực hiện:
B1. Do DATA được bạn dùng kiểu bảng tính
--> Bạn không tận dụng được tối đa object table trong viết VBA
--> Giải pháp: sheet data format thành table + bỏ các dòng không cần thiết
B2. PIVOT DATA thành danh sách HD muốn in (cần phải có điều kiện PIVOT) hoặc viết điều kiện input trong VBA (chắc chưa cần) --> đưa vào biến mảng (theo mình nên học thêm collection hoặc Dictionary) sẽ tiện dụng hơn
B3. Đọc biến lưu và truyền vào FORM; nếu in mỗi lần bằng input số hóa đơn thì không cần sheet DU LIEU

Mình có làm mẫu thử trên file đính kèm để theo tham khảo nhé. Alt + F8 --> chạy xem kết quả lấy dữ liệu. Nếu viết tiếp thì từ đó đưa vào sheet FORM là xong

Hoàng Nhật Phương · 18/5/20

Xin chào tất cả mọi người,

OT viết một câu lệnh đại loại như sau,nếu như thế này, sau khi xử lý hết công việc 1 sẽ tiến hành công việc 2.

Mã:

Sub macro

    Cong viec 1
    Goto Xuly

    Cong viec 2
    Goto Xuly
Xuly:
    Cau lenh xu ly
End sub

Nhưng khi xong công việc 1 thì code không xử lý công việc 2 do câu lệnh Goto Xuly
Nếu viết như thế này, thì sẽ lặp có 2 dòng Cau lenh xu ly :

Mã:

Sub macro

    Cong viec 1
    Cau lenh xu ly

    Cong viec 2
    Cau lenh xu ly

End sub

OT muốn viết 1 dòng "Cau lenh xu ly" rồi sử dụng Goto Xuly thì sẽ viết như thế nào ạ?

VetMini · 18/5/20

Đi tìm hiểu về từ khoá GoSub.
Tôi chỉ như vậy là do ý bạn muốn vậy. Chứ nếu toi viết code thì thiết kế giải thuật khác. Đối với tôi, Go <cái gì đó> là loại lệnh bất đắc dĩ mới phải dùng.

Đại khái nó sử dụng như vầy:

Sub TestCodeGoSub()
code...
congviec1
GoSub CongViecChung
congviec2
GoSub CongViecChung
code...
Exit Sub ' lệnh này rất quan trọng, dùng để tránh code chạy vào sub con bên dưới

CongViecChung:
' sub con, chứa bên trong sub mẹ
những câu lệnh xử lý gì đó...
Return ' lệnh này bảo VBA trở về chạy tiếp dòng sau lệnh gosub

End Sub ' TestCodeGoSub

Lưu ý: sub con là code nội của sub mẹ. Nó sử dụng mọi biến nội của sub mẹ.

SA_DQ · 18/5/20

Hình như phải xài 2 macro Cha & Con, như sau:

PHP:

Sub MacroCha
'Các Công Viêc Cua CôngViec01  '
XuLy
'Các Công Viêc Cua CôngViec02    '
XuLy '?'
End Sub

Mã:

Sub XuLy()
'Các Câu Lênh Trung Gian
End Sub

Hoàng Nhật Phương · 18/5/20

VetMini đã viết:
Đi tìm hiểu về từ khoá GoSub.
Tôi chỉ như vậy là do ý bạn muốn vậy. Chứ nếu toi viết code thì thiết kế giải thuật khác. Đối với tôi, Go <cái gì đó> là loại lệnh bất đắc dĩ mới phải dùng.

Đại khái nó sử dụng như vầy:

Sub TestCodeGoSub()
code...
congviec1
GoSub CongViecChung
congviec2
GoSub CongViecChung
code...
Exit Sub ' lệnh này rất quan trọng, dùng để tránh code chạy vào sub con bên dưới

CongViecChung:
' sub con, chứa bên trong sub mẹ
những câu lệnh xử lý gì đó...
Return ' lệnh này bảo VBA trở về chạy tiếp dòng sau lệnh gosub

End Sub ' TestCodeGoSub

Lưu ý: sub con là code nội của sub mẹ. Nó sử dụng mọi biến nội của sub mẹ.

Xin chào Bác VetMini,
Con cảm ơn Bác đã chỉ dẫn ạ, con không có kinh nghiệm viết code nên không biết dùng cách nào cho tối con mới chỉ nghĩ đến cách đó.
Nếu Bác có cách nào khác xin chỉ dẫn cho con thêm ạ.
Cảm ơn Bác VetMini.

SA_DQ đã viết:
Hình như phải xài 2 macro Cha & Con, như sau:

PHP:

Sub MacroCha 'Các Công Viêc Cua CôngViec01 ' XuLy 'Các Công Viêc Cua CôngViec02 ' XuLy '?' End Sub

Mã:

Sub XuLy() 'Các Câu Lênh Trung Gian End Sub

Con cảm ơn Bác SA_DQ đã chỉ dẫn

Bài đã được tự động gộp: 18/5/20

VetMini đã viết:
Đi tìm hiểu về từ khoá GoSub.
Tôi chỉ như vậy là do ý bạn muốn vậy. Chứ nếu toi viết code thì thiết kế giải thuật khác. Đối với tôi, Go <cái gì đó> là loại lệnh bất đắc dĩ mới phải dùng.

Đại khái nó sử dụng như vầy:

Sub TestCodeGoSub()
code...
congviec1
GoSub CongViecChung
congviec2
GoSub CongViecChung
code...
Exit Sub ' lệnh này rất quan trọng, dùng để tránh code chạy vào sub con bên dưới

CongViecChung:
' sub con, chứa bên trong sub mẹ
những câu lệnh xử lý gì đó...
Return ' lệnh này bảo VBA trở về chạy tiếp dòng sau lệnh gosub

End Sub ' TestCodeGoSub

Lưu ý: sub con là code nội của sub mẹ. Nó sử dụng mọi biến nội của sub mẹ.

Xin chào Bác VetMini
Bác ơi, Bác có thể chỉ con cách dùng câu lệnh với: Resume <label> trong trường hợp này được không ạ?

VetMini · 18/5/20

SA_DQ đã viết:
Hình như phải xài 2 macro Cha & Con, như sau:
...

2 macro Cha và Con là 2 khối riêng biệt và độc lập với nhau. Chúng không chia sẻ biến nội hay cái gì cả, ngoại trừ biến toàn cục.

Nếu macro Con không cần gì đến biến nào của Cha thì nên dùng 2 macro's. Nếu cần một vài biến thì cũng có thể dùng tham để truyền. Cách này khiến Con độc lập với Cha, và rất dễ kiểm soát.

Nhưng nếu đúng theo yêu cầu ở bài #2474, phần sub con cần chạy một số lệnh nào đó, và không xác định cách truyền biến thì GoSub đúng là cái mà người hỏi muốn. Trong bài #2475, code của sub con là code của sub mẹ.

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào Bác VetMini
Bác ơi, Bác có thể chỉ con cách dùng câu lệnh với: Resume <label> trong trường hợp này được không ạ?

Resume không áp dụng cho trường hợp này. Resume là lệnh của bắt lỗi, dùng để tháo bẫy lỗi.
Return là câu lệnh bảo trở về dòng lệnh kế tiếp dòng GoSub, chả liên quan gì đến lỗi cả.

Từ Resume có nghĩa là "tiếp tục lại...". Sau khi xử lý lỗi xong thì lại tiếp tục ở vị trí nào đó.
Từ Return có nghĩa là "trở về...". Sau khi chạy xong đống lệnh trong sub con thì trở về nơi đã gọi sub.

Cu Tồ · 18/5/20

Sub locdulieu()

Sheets(1).Range("A1" & lastcolumn & lastRow).AutoFilter Field:=3, Criteria1:="tangthuong"
lastRow = Range("A85536").End(xlUp).Row
If Sheets("tangthuong").Cells(1, 1) = "" Then
Range("A1:I" & lastRow).Select
Selection.Copy
Sheets("tangthuong").Select
Range("A1").Select
ActiveSheet.Paste
Columns("A:H").Select
Columns("A:H").EntireColumn.AutoFit
Else

Range("A2:I" & lastRow).Select
Selection.Copy
Sheets("tangthuong").Select
lastRow = Range("A85536").End(xlUp).Row
Range("A" & lastRow + 1).Select
ActiveSheet.Paste
Columns("A:H").Select
Columns("A:H").EntireColumn.AutoFit
End If
lastRow = Range("A85536").End(xlUp).Row
Range("A" & lastRow + 1).Select
Sheets(1).Select

mọi người cho hỏi là trong đoạn code này dùng AutoFilter để lọc dữ liệu nhưng khi lọc không có kêt quả nó lại copy ngay dòng tiêu đề để paste ,vậy mn cho hỏi là code sửa ntn để khi autofilter mà không ra kết quả như thế này

thì sẽ không copy nữa mà thực hiện lệnh tiếp theo của đoạn code sau ah?

Ba Tê · 18/5/20

VetMini đã viết:
Đi tìm hiểu về từ khoá GoSub.
Tôi chỉ như vậy là do ý bạn muốn vậy. Chứ nếu toi viết code thì thiết kế giải thuật khác. Đối với tôi, Go <cái gì đó> là loại lệnh bất đắc dĩ mới phải dùng.

Đại khái nó sử dụng như vầy:

Sub TestCodeGoSub()
code...
congviec1
GoSub CongViecChung
congviec2
GoSub CongViecChung
code...
Exit Sub ' lệnh này rất quan trọng, dùng để tránh code chạy vào sub con bên dưới

CongViecChung:
' sub con, chứa bên trong sub mẹ
những câu lệnh xử lý gì đó...
Return ' lệnh này bảo VBA trở về chạy tiếp dòng sau lệnh gosub

End Sub ' TestCodeGoSub

Lưu ý: sub con là code nội của sub mẹ. Nó sử dụng mọi biến nội của sub mẹ.

Tôi chưa từng biết Sub Mẹ, Sub Con viết như Bác @VetMini gợi ý.
Làm liều thử 1 bài xem, nếu có người sửa sai thì sẽ là 1 cách học "Chiêu" mới.

PHP:

Public Sub Cha()
Dim I As Long, J As Long, X As Long
    For I = 1 To 10
        X = X + 1           'Cong Viec 1- Lam gi do'
        For J = 1 To 10    
            Cells(X, J) = "GPE" & Format(I, "000")
        Next J
        X = X + 1
        GoSub Con           'Goi Sub Con'
            X = X + 1       'Cong Viec 2 - Lam gi do'
            For J = 1 To 10
                Cells(X, J) = "Hic!" & Format(I, "000")
            Next J
        X = X + 1
        GoSub Con           'Goi Sub Con'
    Next I
    Exit Sub    'Thoat Sub Cha'
Con:            'Sub Con Lam gi do'
        For J = 1 To 10
            Cells(X, J) = "Con" & " - " & Format(J, "000")
        Next J
Return  'Quay lai dong lenh sau GoSub'
End Sub

Hoàng Nhật Phương · 18/5/20

Ba Tê đã viết:

Tôi chưa từng biết Sub Mẹ Sub, Con viết như Bác @VetMini gợi ý.
Làm liều thử 1 bài xem, nếu có người sửa sai thì sẽ là 1 cách học "Chiêu" mới.

PHP:

Public Sub Cha()
Dim I As Long, J As Long, X As Long
    For I = 1 To 10
        X = X + 1           'Cong Viec 1- Lam gi do'
        For J = 1 To 10    
            Cells(X, J) = "GPE" & Format(I, "000")
        Next J
        X = X + 1
        GoSub Con           'Goi Sub Con'
            X = X + 1       'Cong Viec 2 - Lam gi do'
            For J = 1 To 10
                Cells(X, J) = "Hic!" & Format(I, "000")
            Next J
        X = X + 1
        GoSub Con           'Goi Sub Con'
    Next I
    Exit Sub    'Thoat Sub Cha'
Con:            'Sub Con Lam gi do'
        For J = 1 To 10
            Cells(X, J) = "Con" & " - " & Format(J, "000")
        Next J
Return  'Quay lai dong lenh sau GoSub'
End Sub

Con cảm ơn Thầy đã chỉ dẫn,con sẽ nghiên cứu tìm hiểu để áp dụng ạ.

Ba Tê · 18/5/20

Nguyễn Hoàng Oanh Thơ đã viết:
Con cảm ơn Thầy đã chỉ dẫn,con sẽ nghiên cứu tìm hiểu để áp dụng ạ.

Đã nói là lần đầu tiên "mò" cái này.
Tôi viết "thí thí" còn chưa biết đúng sai, sao dám nhận là "chỉ dẫn".
Chưa chắc ổn, Chờ nhiều người hiểu rõ chuyện này góp ý đã.

SA_DQ · 18/5/20

cuto24 đã viết:
Sub locdulieu()
Sheets(1).Range("A1" & lastcolumn & lastRow).AutoFilter Field:=3, Criteria1:="活动优惠"
lastRow = Range("A85536").End(xlUp).Row
If Sheets("活动优惠").Cells(1, 1) = "" Then
Range("A1:I" & lastRow).Select
Selection.Copy
Sheets("活动优惠").Select
Range("A1").Select
ActiveSheet.Paste
Columns("A:H").Select
Columns("A:H").EntireColumn.AutoFit
Else
Range("A2:I" & lastRow).Select
Selection.Copy
Sheets("活动优惠").Select
lastRow = Range("A85536").End(xlUp).Row
Range("A" & lastRow + 1).Select
ActiveSheet.Paste
Columns("A:H").Select
Columns("A:H").EntireColumn.AutoFit
End If
astRow = Range("A85536").End(xlUp).Row
Range("A" & lastRow + 1).Select
Sheets(1).Select

Trong code có đoạn nào nói về đường lưỡi bò không vậy bạn?

Cu Tồ · 18/5/20

SA_DQ đã viết:
Trong code có đoạn nào nói về đường lưỡi bò không vậy bạn?

không bác ơi,chỉ là danh sách tặng thưởng thôi mà

Cu Tồ · 18/5/20

mong mn giúp đỡ

Bài đã được tự động gộp: 18/5/20

cuto24 đã viết:
Sub locdulieu()

Sheets(1).Range("A1" & lastcolumn & lastRow).AutoFilter Field:=3, Criteria1:="tangthuong"
lastRow = Range("A85536").End(xlUp).Row
If Sheets("tangthuong").Cells(1, 1) = "" Then
Range("A1:I" & lastRow).Select
Selection.Copy
Sheets("tangthuong").Select
Range("A1").Select
ActiveSheet.Paste
Columns("A:H").Select
Columns("A:H").EntireColumn.AutoFit
Else

Range("A2:I" & lastRow).Select
Selection.Copy
Sheets("tangthuong").Select
lastRow = Range("A85536").End(xlUp).Row
Range("A" & lastRow + 1).Select
ActiveSheet.Paste
Columns("A:H").Select
Columns("A:H").EntireColumn.AutoFit
End If
lastRow = Range("A85536").End(xlUp).Row
Range("A" & lastRow + 1).Select
Sheets(1).Select

mọi người cho hỏi là trong đoạn code này dùng AutoFilter để lọc dữ liệu nhưng khi lọc không có kêt quả nó lại copy ngay dòng tiêu đề để paste ,vậy mn cho hỏi là code sửa ntn để khi autofilter mà không ra kết quả như thế này View attachment 237539 thì sẽ không copy nữa mà thực hiện lệnh tiếp theo của đoạn code sau ah?

mong mn giúp đỡ

VetMini · 18/5/20

Ba Tê đã viết:

Tôi chưa từng biết Sub Mẹ Sub, Con viết như Bác @VetMini gợi ý.
Làm liều thử 1 bài xem, nếu có người sửa sai thì sẽ là 1 cách học "Chiêu" mới.

PHP:

Public Sub Cha()
Dim I As Long, J As Long, X As Long
    For I = 1 To 10
        X = X + 1           'Cong Viec 1- Lam gi do'
        For J = 1 To 10  
            Cells(X, J) = "GPE" & Format(I, "000")
        Next J
        X = X + 1
        GoSub Con           'Goi Sub Con'
            X = X + 1       'Cong Viec 2 - Lam gi do'
            For J = 1 To 10
                Cells(X, J) = "Hic!" & Format(I, "000")
            Next J
        X = X + 1
        GoSub Con           'Goi Sub Con'
    Next I
    Exit Sub    'Thoat Sub Cha'
Con:            'Sub Con Lam gi do'
        For J = 1 To 10
            Cells(X, J) = "Con" & " - " & Format(J, "000")
        Next J
Return  'Quay lai dong lenh sau GoSub'
End Sub

Mục đích chính của GoSub là để tránh lặp lại code.
Nếu công việc 1 và công việc 2 gần giống nhau thì bạn cũng có thể tạo một sub con nữa.
Lưu ý rằng hai công việc có các lệnh giống nhau nhưng thong số khác nhau cho nên ta phải dùng một biến để thực hiện thông số này (biến danDau trong code).

PHP:

Public Sub Cha()
Dim I As Long, J As Long, X As Long
DIM daDau As String
    For I = 1 To 10
      ' công việc 1, làm gì đó '
      danDau = "GPE"
      GoSub Con_Ruot
      danDau = "Con - "
      GoSub Con_Ghe
      ' công việc 2, làm gì đó '
      danDau = "Hic!"
      GoSub Con_Ruot
      danDau = "Con - "
      GoSub Con_Ghe
    Next I
    Exit Sub    'Thoat Sub Cha'

Con_Ruot:
        ' công việc 3, làm gì đó '
        ' sau khi hoàn tất công việc 3, gọi sub Con_Ghe để thực hiện việc tăng X và ghi trị vào 10 cells '
        GoSub Con_Ghe
Return

Con_Ghe:            'Sub Con Lam gi do'
        X = X + 1
        For J = 1 To 10
            Cells(X, J) = danDau & Format(J, "000")
        Next J
Return
End Sub

Code trên tôi cố tình cho thấy Con_Ruot có thể gọi Con_Ghe vô tư.
(ngược lại, Con_Ghe có thể gọi Con_Ruot nếu muốn)

ppc0312 · 18/5/20

VetMini đã viết:
Mục đích chính của GoSub là để tránh lặp lại code.
Nếu công việc 1 và công việc 2 gần giống nhau thì bạn cũng có thể tạo một sub con nữa.
Lưu ý rằng hai công việc có các lệnh giống nhau nhưng thong số khác nhau cho nên ta phải dùng một biến để thực hiện thông số này (biến danDau trong code).

PHP:

Public Sub Cha() Dim I As Long, J As Long, X As Long DIM daDau As String For I = 1 To 10 ' công việc 1, làm gì đó danDau = "GPE" GoSub Con_Ruot danDau = "Con - " GoSub Con_Ghe ' công việc 2, làm gì đó danDau = "Hic!" GoSub Con_Ruot danDau = "Con - " GoSub Con_Ghe Next I Exit Sub 'Thoat Sub Cha' Con_Ruot: ' công việc 3, làm gì đó ' sau khi hoàn tất công việc 3, gọi sub Con_Ghe để thực hiện việc tăng X và ghi trị vào 10 cells GoSub Con_Ghe 'Goi Sub Con' Return Con_Ghe: 'Sub Con Lam gi do' X = X + 1 For J = 1 To 10 Cells(X, J) = danDau & Format(J, "000") Next J Return End Sub

Code trên tôi cố tình cho thấy Con_Ruot có thể gọi Con_Ghe vô tư.
(ngược lại, Con_Ghe có thể gọi Con_Ruot nếu muốn)

Bác cứ phức tạp vấn đề, cứ chia ra sub con riêng cho nhanh, và như thế thỏa mãi số con mà không rối... còn truyền biến thì độc lập hay phụ thuộc cũng tùy thích

GoSub đúng như bác nói người ta hạn chế dùng, nếu dùng dùng cho trường hợp đặc biệt hay vui mà thôi

VetMini · 18/5/20

ppc0312 đã viết:
Bác cứ phức tạp vấn đề, cứ chia ra sub con riêng cho nhanh, và như thế thỏa mãi số con mà không rối... còn truyền biến thì độc lập hay phụ thuộc cũng tùy thích

GoSub đúng như bác nói người ta hạn chế dùng, nếu dùng dùng cho trường hợp đặc biệt hay vui mà thôi

Sẵn đề tài ở bài #2724, Tôi chỉ dẫn dắt về một kỹ thuật code mà nó gần sát nhất với yêu cầu củab bài.

Vì là dẫn dắt cho nên tôi thêm hoa lá cành cho nó hơi phức tạp một chút. Chứ đơn giản quá thì chả có mấy để học.

Trước khi vào, tôi cũng có nói rằng Go<...> là kỹ thuật phi cấu trúc (non-structred). Chính bản thân tôi cũng không thích dùng.
Nhất là khi Sub con dựa vào nhiều thông số và thay đổi nhiều biến, rất khó kiểm soát và debug.

Nhưng nếu tôn chỉ của diễn đàn này là tốc độ code thì Go<...> là con đường đáng bỏ tâm nghiên cứu.
Code phi cấu trúc thường chạy nhanh hơn. GoSub là lệnh rẽ nhánh lập tức, VBA chỉ phải nhét ngăn xếp cái địa chỉ để 'Return'. Nếu gọi hàm riêng biệt thì VBA phải nhét ngăn xếp nhiều thứ nữa. Đồng thời, vì không phải dùng ngăn xếp nhiều nên dệ quy cũng lâu bị tràn ngăn xếp hơn.

Hoàng Nhật Phương · 19/5/20

Xin chào tất cả mọi mọi người,
OT có một vấn đề như sau:

Làm thế nào để từ bảng 1 chuyển sang bảng 2 thay đổi định dạng.
Cột A -> F (Long-> String)
Cột B -> G (Stirng -> Long)

OT đã code một đoạn sau để thử nhưng không được:

Mã:

Option Explicit

Sub Test_String_And_Long()
    Dim Vao(), Ra(), I As Long
    Vao = Sheet1.Range("A3:C12").Value
    ReDim Ra(1 To UBound(Vao, 1), 1 To UBound(Vao, 2))
    For I = 1 To UBound(Vao, 1)
       Ra(I, 1) = CStr(Vao(I, 1))
       Ra(I, 2) = CLng(Vao(I, 2))
       Ra(I, 3) = Ra(I, 1) + Ra(I, 2)
    Next I
    Sheet1.Range("F3").Resize(UBound(Ra, 1), UBound(Ra, 2)) = Ra
End Sub

Nhờ các Bạn chỉ dẫn cho cách làm ạ.

Hoàng Nhật Phương · 19/5/20

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào tất cả mọi mọi người,
OT có một vấn đề như sau:

OT đã code một đoạn sau để thử nhưng không được:

Mã:

Option Explicit Sub Test_String_And_Long() Dim Vao(), Ra(), I As Long Vao = Sheet1.Range("A3:C12").Value ReDim Ra(1 To UBound(Vao, 1), 1 To UBound(Vao, 2)) For I = 1 To UBound(Vao, 1) Ra(I, 1) = CStr(Vao(I, 1)) Ra(I, 2) = CLng(Vao(I, 2)) Ra(I, 3) = Ra(I, 1) + Ra(I, 2) Next I Sheet1.Range("F3").Resize(UBound(Ra, 1), UBound(Ra, 2)) = Ra End Sub

Nhờ các Bạn chỉ dẫn cho cách làm ạ.

View attachment 237625

Hình như cả CStr & CLng đều không có tác dụng trong trường hợp này ạ?
Nếu làm như thế này thì lại được:

Mã:

Option Explicit

Sub Test_String_And_Long()
    Dim Vao(), Ra(), I As Long
    Vao = Sheet1.Range("A3:C12").Value
    ReDim Ra(1 To UBound(Vao, 1), 1 To UBound(Vao, 2))
    For I = 1 To UBound(Vao, 1)
       Ra(I, 1) = "'" & Vao(I, 1)
       Ra(I, 2) = Vao(I, 2)
       Ra(I, 3) = "=SUM(RC[-2]:RC[-1])"
    Next I
    Sheet1.Range("F3").Resize(UBound(Ra, 1), UBound(Ra, 2)) = Ra
End Sub

Có cách làm khác không ạ?

CHAOQUAY · 19/5/20

Nguyễn Hoàng Oanh Thơ đã viết:
Hình như cả CStr & CLng đều không có tác dụng trong trường hợp này ạ?
Nếu làm như thế này thì lại được:

Mã:

Option Explicit Sub Test_String_And_Long() Dim Vao(), Ra(), I As Long Vao = Sheet1.Range("A3:C12").Value ReDim Ra(1 To UBound(Vao, 1), 1 To UBound(Vao, 2)) For I = 1 To UBound(Vao, 1) Ra(I, 1) = "'" & Vao(I, 1) Ra(I, 2) = Vao(I, 2) Ra(I, 3) = "=SUM(RC[-2]:RC[-1])" Next I Sheet1.Range("F3").Resize(UBound(Ra, 1), UBound(Ra, 2)) = Ra End Sub

Có cách làm khác không ạ?

Chưa thử nhưng dùng lệnh clear xóa vùng ("F3").resize... trước khi điền xuống sheet xem.

Hoàng Nhật Phương · 19/5/20

CHAOQUAY đã viết:
Chưa thử nhưng dùng lệnh clear xóa vùng ("F3").resize... trước khi điền xuống sheet xem.

Xin chào CHAOQUAY
Dạ thì kết quả nó trả về giống Bảng 2 như ảnh trong bài 2489 theo ý muốn của OT đó Bạn.
Vấn đề là ở đây OT muốn hỏi xem có cách nào chuyển kiểu số sang kiểu text hoặc ngược lại trong mảng không ạ, nhưng mà với trường hợp của OT hình như cứ đưa số định dạng text vào mảng là nó chuyển thành số hay sao ấy,, híc!
'-------------------------------------
Ah nó có dấu ' ở đầu Bạn ơi...

CHAOQUAY · 19/5/20

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào CHAOQUAY
Dạ thì kết quả nó trả về giống Bảng 2 như ảnh trong bài 2489 theo ý muốn của OT đó Bạn.
Vấn đề là ở đây OT muốn hỏi xem có cách nào chuyển kiểu số sang kiểu text hoặc ngược lại trong mảng không ạ, nhưng mà với trường hợp của OT hình như cứ đưa số định dạng text vào mảng là nó chuyển thành số hay sao ấy,, híc!
'-------------------------------------
Ah nó có dấu ' ở đầu Bạn ơi...

bạn thử khai báo
dim Ra() as string xem

Hoàng Nhật Phương · 19/5/20

CHAOQUAY đã viết:
bạn thử khai báo
dim Ra() as string xem

Dạ , nếu làm thế này thì cả mảng Ra thàn chuỗi hết ạ, kết quả trả về không chỉ riêng cột F là chuỗi mà cả G & H cũng thành chuỗi theo luôn.
Có cách nào vẫn xử lý trong cùng mảng được không Bạn?

CHAOQUAY · 19/5/20

Nguyễn Hoàng Oanh Thơ đã viết:
Dạ , nếu làm thế này thì cả mảng Ra thàn chuỗi hết ạ, kết quả trả về không chỉ riêng cột F là chuỗi mà cả G & H cũng thành chuỗi theo luôn.
Có cách nào vẫn xử lý trong cùng mảng được không Bạn?

Thường là mảng chỉ khai báo theo một kiểu, nếu vậy bạn tách mảng Ra() thành 1 vài mảng có kiểu khác nhau xem sao.

Bài đã được tự động gộp: 19/5/20

Xóa format của vùng điền kết quả trong sheet cũng cần quan tâm đó bạn

Hau151978 · 19/5/20

Nguyễn Hoàng Oanh Thơ đã viết:
Dạ , nếu làm thế này thì cả mảng Ra thàn chuỗi hết ạ, kết quả trả về không chỉ riêng cột F là chuỗi mà cả G & H cũng thành chuỗi theo luôn.
Có cách nào vẫn xử lý trong cùng mảng được không Bạn?

Tự động chuyển đổi kiểu là một đặc điểm của VBA. Khi bạn đã biết 1 cột là text, 1 cột là number thì tốt nhất đừng cộng vào nhau để tránh ra kết quả không mong muốn. Phép tính trên sheet và VBA cũng có thể khác nhau, chẳng hạn trong VBA "1"+"1"="11" (bạn nhập ?"1"+"1" trong cửa sổ immediate sẽ thấy kết quả là 11) nhưng trên sheet thì "1"+"1"=2 (bạn nhập công thức A1 ="1"+"1" kết quả là 2). Do đó trước khi làm phép tính thì bạn cần tự quyết định các toán hạng trong phép tính là số hay chuỗi và đừng mong chờ VBA chuyển đổi đúng ý mình. Nếu trong VBA mà ta cần cộng nhiều ô trên sheet và chỉ cộng các số, bỏ qua text thì có thể dùng Application.Sum để tính.

ongke0711 · 20/5/20

Nguyễn Hoàng Oanh Thơ đã viết:

Mã:

Option Explicit

Sub Test_String_And_Long()
    Dim Vao(), Ra(), I As Long
    Vao = Sheet1.Range("A3:C12").Value
    ReDim Ra(1 To UBound(Vao, 1), 1 To UBound(Vao, 2))
    For I = 1 To UBound(Vao, 1)
       Ra(I, 1) = CStr(Vao(I, 1))
       Ra(I, 2) = CLng(Vao(I, 2))
       Ra(I, 3) = Ra(I, 1) + Ra(I, 2)
    Next I
    Sheet1.Range("F3").Resize(UBound(Ra, 1), UBound(Ra, 2)) = Ra
End Sub

Thực ra là theo cách trên đổi kiểu dữ liệu trong mảng là được nhưng khi gán xuống Sheet thì không như ý. Vấn đề này thì anh chưa biết nguyên nhân của nó.
Đối với code trên anh nghĩ không cần tạo thêm mảng Ra(), chuyển đổi luôn trong mảng Vao() cũng được (thay chữ "Ra" -> "Vao" xem thử) . Anh test với Typename thì thấy ra đúng kiểu dữ liệu cần chuyển, chỉ gán xuống Sheet là lỗi.
Chờ các bạn nào biết giải thích thêm để học hỏi vụ này.

Hoàng Nhật Phương · 20/5/20

ongke0711 đã viết:
Thực ra là theo cách trên đổi kiểu dữ liệu trong mảng là được nhưng khi gán xuống Sheet thì không như ý. Vấn đề này thì anh chưa biết nguyên nhân của nó.
Đối với code trên anh nghĩ không cần tạo thêm mảng Ra(), chuyển đổi luôn trong mảng Vao() cũng được (thay chữ "Ra" -> "Vao" xem thử) . Anh test với Typename thì thấy ra đúng kiểu dữ liệu cần chuyển, chỉ gán xuống Sheet là lỗi.
Chờ các bạn nào biết giải thích thêm để học hỏi vụ này.

Đúng rồi anh, trong mảng thì không vấn đề gì nhưng khi đưa xuống sheet thì thay đổi do đó phải thêm dòng code: NumberFormat trước khi đưa dữ liệu xuống sheet anh ạ.
OT cũng đang chờ một giải pháp khác ạ.
Cảm ơn anh đã thông tin ạ

HieuCD · 20/5/20

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào tất cả mọi mọi người,
OT có một vấn đề như sau:

OT đã code một đoạn sau để thử nhưng không được:

Mã:

Option Explicit Sub Test_String_And_Long() Dim Vao(), Ra(), I As Long Vao = Sheet1.Range("A3:C12").Value ReDim Ra(1 To UBound(Vao, 1), 1 To UBound(Vao, 2)) For I = 1 To UBound(Vao, 1) Ra(I, 1) = CStr(Vao(I, 1)) Ra(I, 2) = CLng(Vao(I, 2)) Ra(I, 3) = Ra(I, 1) + Ra(I, 2) Next I Sheet1.Range("F3").Resize(UBound(Ra, 1), UBound(Ra, 2)) = Ra End Sub

Nhờ các Bạn chỉ dẫn cho cách làm ạ.

View attachment 237625

Khai báo 1 mảng vào 2 mảng Ra
Dim Vao(), Ra() as string, Ra2() as long
Hoặc
Dim Vao(), Ra() as string, Ra2()

Hoàng Nhật Phương · 20/5/20

HieuCD đã viết:
Khai báo 1 mảng vào 2 mảng Ra
Dim Vao(), Ra() as string, Ra2() as long
Hoặc
Dim Vao(), Ra() as string, Ra2()

Dạ, con cảm ơn Bác Hiếu nhiều ạ,có lẽ chỉ còn cách này ạ.

Cu Tồ · 20/5/20

mn cho hỏi là trong diễn đang mình có ai sử dụng bộ soạn thảo wps không ah? vì mình thấy giữa mrs và wps khi chạy vba thì có một số không tương đồng về cách viết code

lovestoryo0o · 21/5/20

Em xin chào các bác ạ,
Em đang tập tành học VBA và hiện tại đang gặp khó về vấn đề này ạ.
Cụ thể là em có 1 file với số tiền phải chi cho người lao động thuộc các cụm, dữ liệu mỗi cụm cách nhau bởi 1 dòng trống.
Em muốn viết 1 code tự tìm dòng cuối của 1 cụm sau đó, xóa dữ liệu thừa ở dòng "cuối +1" và lấy tổng số tiền (cột G) của cụm đó vào ô trống của dòng "cuối +1". Sau đó tiếp tục tìm đến dòng cuối của cụm thứ 2 và xóa dữ liệu thừa ở dòng "cuối +1" và lấy tổng số tiền (cột G) chỉ của cụm thứ 2 vào ô trống của dòng "cuối +1". Cứ thế lặp lại cho đến khi hết dữ liệu.
Hiện tại em chỉ viết được code cho 1 cụm và ko biết viết vòng lặp như thế nào ạ.

Mã:

Sub TinhTong()

    Sheet1.Activate
    Dim Lr As Long
    Dim i As Long

    ' Lay dong cuoi
    Lr = Sheet1.Range("G1").End(xlDown).Row
    i = Lr + 1
    
    ' To dam o dong cuoi +1
    Rows(i).Select
    Selection.ClearContents
    Selection.Font.Bold = True
    
    ' Tinh tong o dong cuoi +1
    Dim Rng As Range
    Dim c As Range
    Set Rng = Range("G1:G" & Lr)
    Set c = Range("G1").End(xlDown).Offset(1, 0)
    c.Formula = "=SUM(" & Rng.Address(False, False) & ")"
    
End Sub

Kính mong các bác xem giúp em file ạ.
Em xin chân thành cám ơn các bác ạ.

giaiphap · 21/5/20

lovestoryo0o đã viết:
Em xin chào các bác ạ,
Em đang tập tành học VBA và hiện tại đang gặp khó về vấn đề này ạ.
Cụ thể là em có 1 file với số tiền phải chi cho người lao động thuộc các cụm, dữ liệu mỗi cụm cách nhau bởi 1 dòng trống.
Em muốn viết 1 code tự tìm dòng cuối của 1 cụm sau đó, xóa dữ liệu thừa ở dòng "cuối +1" và lấy tổng số tiền (cột G) của cụm đó vào ô trống của dòng "cuối +1". Sau đó tiếp tục tìm đến dòng cuối của cụm thứ 2 và xóa dữ liệu thừa ở dòng "cuối +1" và lấy tổng số tiền (cột G) chỉ của cụm thứ 2 vào ô trống của dòng "cuối +1". Cứ thế lặp lại cho đến khi hết dữ liệu.
Hiện tại em chỉ viết được code cho 1 cụm và ko biết viết vòng lặp như thế nào ạ.

Mã:

Sub TinhTong() Sheet1.Activate Dim Lr As Long Dim i As Long ' Lay dong cuoi Lr = Sheet1.Range("G1").End(xlDown).Row i = Lr + 1 ' To dam o dong cuoi +1 Rows(i).Select Selection.ClearContents Selection.Font.Bold = True ' Tinh tong o dong cuoi +1 Dim Rng As Range Dim c As Range Set Rng = Range("G1:G" & Lr) Set c = Range("G1").End(xlDown).Offset(1, 0) c.Formula = "=SUM(" & Rng.Address(False, False) & ")" End Sub

Kính mong các bác xem giúp em file ạ.
Em xin chân thành cám ơn các bác ạ.

Không biết đúng ý bạn không nhưng thử test code xem.

Mã:

Sub GPE()
Dim rLast As Long, Rng As Range, sCell As Range
    With Sheet1
        rLast = .Range("G1000000").End(xlUp).Row
        Set Rng = .Range("G1:G" & rLast).SpecialCells(xlCellTypeConstants, 1)
        For Each sCell In Rng.Areas
            sCell.Cells(1, 1).Offset(sCell.Rows.Count).Formula = "=SUM(" & sCell.Address(0, 0) & ")"
        Next sCell
    End With
End Sub

lovestoryo0o · 21/5/20

giaiphap đã viết:

Không biết đúng ý bạn không nhưng thử test code xem.

Mã:

Sub GPE()
Dim rLast As Long, Rng As Range, sCell As Range
    With Sheet1
        rLast = .Range("G1000000").End(xlUp).Row
        Set Rng = .Range("G1:G" & rLast).SpecialCells(xlCellTypeConstants, 1)
        For Each sCell In Rng.Areas
            sCell.Cells(1, 1).Offset(sCell.Rows.Count).Formula = "=SUM(" & sCell.Address(0, 0) & ")"
        Next sCell
    End With
End Sub

Quá tuyệt vời bác ạ.
Em xin cảm ơn bác nhiều ạ.
Và em xin mạo muội nhờ bác thêm 1 chút nữa được ko ạ.
Bác có thể thêm vào tác vụ xóa hết dữ liệu của cả dòng mà có chứa ô có hàm tổng, chỉ để lại ô có hàm tổng và đồng thời tô đậm ô đó được ko ạ.
Em xin cảm ơn bác 1 lần nữa ạ.

giaiphap · 22/5/20

lovestoryo0o đã viết:
Quá tuyệt vời bác ạ.
Em xin cảm ơn bác nhiều ạ.
Và em xin mạo muội nhờ bác thêm 1 chút nữa được ko ạ.
Bác có thể thêm vào tác vụ xóa hết dữ liệu của cả dòng mà có chứa ô có hàm tổng, chỉ để lại ô có hàm tổng và đồng thời tô đậm ô đó được ko ạ.
Em xin cảm ơn bác 1 lần nữa ạ.

Sửa code lại chút.

Mã:

Sub GPE()
Dim rLast As Long, Rng As Range, sCell As Range, iRow As Long
    With Sheet1
        rLast = .Range("G1000000").End(xlUp).Row
        .Range("G1:G" & rLast).Font.Bold = False
        Set Rng = .Range("G1:G" & rLast).SpecialCells(xlCellTypeConstants, 1)
        For Each sCell In Rng.Areas
            iRow = sCell.Cells(1, 1).Offset(sCell.Rows.Count).Row
            .Rows(iRow).ClearContents
            .Range("G" & iRow).Formula = "=SUM(" & sCell.Address(0, 0) & ")"
            .Range("G" & iRow).Font.Bold = True
        Next sCell
    End With
End Sub

Ba Tê · 22/5/20

lovestoryo0o đã viết:
Em xin chào các bác ạ,
Em đang tập tành học VBA và hiện tại đang gặp khó về vấn đề này ạ.
Cụ thể là em có 1 file với số tiền phải chi cho người lao động thuộc các cụm, dữ liệu mỗi cụm cách nhau bởi 1 dòng trống.
Em muốn viết 1 code tự tìm dòng cuối của 1 cụm sau đó, xóa dữ liệu thừa ở dòng "cuối +1" và lấy tổng số tiền (cột G) của cụm đó vào ô trống của dòng "cuối +1". Sau đó tiếp tục tìm đến dòng cuối của cụm thứ 2 và xóa dữ liệu thừa ở dòng "cuối +1" và lấy tổng số tiền (cột G) chỉ của cụm thứ 2 vào ô trống của dòng "cuối +1". Cứ thế lặp lại cho đến khi hết dữ liệu.
Hiện tại em chỉ viết được code cho 1 cụm và ko biết viết vòng lặp như thế nào ạ.

Mã:

Sub TinhTong() Sheet1.Activate Dim Lr As Long Dim i As Long ' Lay dong cuoi Lr = Sheet1.Range("G1").End(xlDown).Row i = Lr + 1 ' To dam o dong cuoi +1 Rows(i).Select Selection.ClearContents Selection.Font.Bold = True ' Tinh tong o dong cuoi +1 Dim Rng As Range Dim c As Range Set Rng = Range("G1:G" & Lr) Set c = Range("G1").End(xlDown).Offset(1, 0) c.Formula = "=SUM(" & Rng.Address(False, False) & ")" End Sub

Kính mong các bác xem giúp em file ạ.
Em xin chân thành cám ơn các bác ạ.

Thêm một cách viết đơn giản.

PHP:

Sub TinhTong2()
Dim Lr As Long, i As Long, k As Long
With Sheet1
    Lr = .Range("G1000").End(xlUp).Row + 1  ' Lay dong trong cuoi'
    For i = 1 To Lr                         'Xet cot G tu dong 1 den dong cuoi'
        k = k + 1                           'Dem so dong'
        If .Range("G" & i).Value = Empty Then           'Neu gap o trong cot G = trong'
            .Range("A" & i).Resize(, 10).ClearContents  'Xoa du lieu tu cot A den cot J'
            .Range("G" & i).Font.Bold = True            'To dam chi mot o cot G'
            .Range("G" & i).Value = "=SUM(R[-" & k - 1 & "]C:R[-1]C)"   'Cong thuc Tong'
            k = 0   'So dem =0, bat dau dem lai'
        End If
    Next i
End With
End Sub

lovestoryo0o · 22/5/20

giaiphap đã viết:

Sửa code lại chút.

Mã:

Sub GPE()
Dim rLast As Long, Rng As Range, sCell As Range, iRow As Long
    With Sheet1
        rLast = .Range("G1000000").End(xlUp).Row
        .Range("G1:G" & rLast).Font.Bold = False
        Set Rng = .Range("G1:G" & rLast).SpecialCells(xlCellTypeConstants, 1)
        For Each sCell In Rng.Areas
            iRow = sCell.Cells(1, 1).Offset(sCell.Rows.Count).Row
            .Rows(iRow).ClearContents
            .Range("G" & iRow).Formula = "=SUM(" & sCell.Address(0, 0) & ")"
            .Range("G" & iRow).Font.Bold = True
        Next sCell
    End With
End Sub

Ba Tê đã viết:

Thêm một cách viết đơn giản.

PHP:

Sub TinhTong2()
Dim Lr As Long, i As Long, k As Long
With Sheet1
    Lr = .Range("G1000").End(xlUp).Row + 1  ' Lay dong trong cuoi'
    For i = 1 To Lr                         'Xet cot G tu dong 1 den dong cuoi'
        k = k + 1                           'Dem so dong'
        If .Range("G" & i).Value = Empty Then           'Neu gap o trong cot G = trong'
            .Range("A" & i).Resize(, 10).ClearContents  'Xoa du lieu tu cot A den cot J'
            .Range("G" & i).Font.Bold = True            'To dam chi mot o cot G'
            .Range("G" & i).Value = "=SUM(R[-" & k - 1 & "]C:R[-1]C)"   'Cong thuc Tong'
            k = 0   'So dem =0, bat dau dem lai'
        End If
    Next i
End With
End Sub

Cám ơn 2 bác nhiều ạ. Code quá tuyệt.

panda1112009 · 22/5/20

Em có đoạn code ntn.. và e muốn khi chạy đoạn mã này nó sẽ hiện ra 1 ô thông báo để mình chọn số đơn vị muốn làm tròn vd: 3;0;-3. Vì trong code này nó mặc định bằng 0 nên nhiều lúc phải chỉnh tay khá mất công.. e xin cảm ơn ạ.

Mã:

Public Sub ChenRound()
Dim Vung, Cll, Tam
Set Vung = Application.InputBox("Nhap vung muon chen ham ROUND", , , , , , , 8)
For Each Cll In Vung
Tam = Replace(Cll.Formula, "=", "")
Cll.Formula = "=ROUND(" & Tam & ",0)"
Next Cll
End Sub

giaiphap · 22/5/20

panda1112009 đã viết:
Em có đoạn code ntn.. và e muốn khi chạy đoạn mã này nó sẽ hiện ra 1 ô thông báo để mình chọn số đơn vị muốn làm tròn vd: 3;0;-3. Vì trong code này nó mặc định bằng 0 nên nhiều lúc phải chỉnh tay khá mất công.. e xin cảm ơn ạ.

Mã:

Public Sub ChenRound() Dim Vung, Cll, Tam Set Vung = Application.InputBox("Nhap vung muon chen ham ROUND", , , , , , , 8) For Each Cll In Vung Tam = Replace(Cll.Formula, "=", "") Cll.Formula = "=ROUND(" & Tam & ",0)" Next Cll End Sub

Sửa thế này.

Mã:

Public Sub ChenRound()
    Dim Vung, Cll, Tam
    Dim iNum As Integer
   
    Set Vung = Application.InputBox("Nhap vung muon chen ham ROUND", , , , , , , 8)
    iNum = Application.InputBox("Nh" & ChrW(7853) & "p s" & ChrW(7889) & " làm tròn.", _
            "B" & ChrW(7841) & "n ph" & ChrW(7843) & "i nh" & ChrW(7853) & "p s" & ChrW(7889) & " nguyên.", , , , , , 1)
    For Each Cll In Vung
        Tam = Replace(Cll.Formula, "=", "")
        Cll.Formula = "=ROUND(" & Tam & "," & iNum & ")"
    Next Cll
End Sub

panda1112009 · 25/5/20

giaiphap đã viết:

Sửa thế này.

Mã:

Public Sub ChenRound()
    Dim Vung, Cll, Tam
    Dim iNum As Integer
  
    Set Vung = Application.InputBox("Nhap vung muon chen ham ROUND", , , , , , , 8)
    iNum = Application.InputBox("Nh" & ChrW(7853) & "p s" & ChrW(7889) & " làm tròn.", _
            "B" & ChrW(7841) & "n ph" & ChrW(7843) & "i nh" & ChrW(7853) & "p s" & ChrW(7889) & " nguyên.", , , , , , 1)
    For Each Cll In Vung
        Tam = Replace(Cll.Formula, "=", "")
        Cll.Formula = "=ROUND(" & Tam & "," & iNum & ")"
    Next Cll
End Sub

Dạ e cảm ơn a nhiều ạ.. trước e thay bằng i chứ k phải inum nên chạy chả được.. k rành VBA nó chán thế đấy @@

Duong.bach · 26/5/20

Mọi người cho mình hỏi, ngoài cách dùng vòng lặp for, có cách nào để insert công thức cho nhiều ô trong không ạ?
ví dụ như vòng for như này. Thanks all
Dim i As Integer
For i = 1 To 50
Range("a" & i) = Range("b" & i) + Range("c" & i)
Next

CHAOQUAY · 26/5/20

Duong.bach đã viết:
Mọi người cho mình hỏi, ngoài cách dùng vòng lặp for, có cách nào để insert công thức cho nhiều ô trong không ạ?
ví dụ như vòng for như này. Cảm ơn all
Dim i As Integer
For i = 1 To 50
Range("a" & i) = Range("b" & i) + Range("c" & i)
Next

Bạn tham khảo đoạn code dưới

Mã:

Sheet1.Range("A1:A50") = "=RC[1]+RC[2]"

Duong.bach · 26/5/20

CHAOQUAY đã viết:
Bạn tham khảo đoạn code dưới

Mã:

Sheet1.Range("A1:A50") = "=RC[1]+RC[2]"

Thanks bác, em biết thêm 1 phương thức mới. cho em hỏi thêm là em muốn cell ở cột A chỉ insert lệnh khi cell cột B và C có giá trị thì phải làm như nào ạ, khi cell cột B hoặc C "" thì cell cột A cũng trống tương ứng.

SA_DQ · 27/5/20

Bạn thử vầy:
Sub TinhTongKhongTrong()
Sheet1.Range("A2:A50") = "=IF(AND(RC[1]<>"""", RC[2]<>"""" ),RC[1]+RC[2],"""")"
End Sub

Duong.bach · 27/5/20

SA_DQ đã viết:
Bạn thử vầy:
Sub TinhTongKhongTrong()
Sheet1.Range("A2:A50") = "=IF(AND(RC[1]<>"""", RC[2]<>"""" ),RC[1]+RC[2],"""")"
End Sub

Thanks bác, ý em muốn hỏi là nó trống luôn chứ k fai hiển thị trống ạ?
Có cách nào chuyển về dạng applitcation ko bác. Kiểu như code dưới này, nhưng em chưa làm nó chạy dc
If Target.Address = "$A$x" Then
Range("A" & x) = Range("B" & x) + Range("C" & x)

Ba Tê · 27/5/20

Duong.bach đã viết:
Cảm ơn bác, ý em muốn hỏi là nó trống luôn chứ k fai hiển thị trống ạ?
Có cách nào chuyển về dạng applitcation ko bác

Dạng applitcation là sao?
Ý muốn này chỉ có thể trở về cách For... Next

PHP:

For I = DòngĐầu To DòngCuối
    If Range("B" & I) + Range("C" & I) > 0 Then
        Range("A" & I) = "=RC[1]+RC[2]"
    End If
Next I

Duong.bach · 27/5/20

Ý em là không muốn hiển thị công thức trong cell ý

Bài đã được tự động gộp: 27/5/20

Ba Tê đã viết:
Dạng applitcation là sao?
Ý muốn này chỉ có thể trở về cách For... Next

PHP:

For I = DòngĐầu To DòngCuối If Range("B" & I) + Range("C" & I) > 0 Then Range("A" & I) = "=RC[1]+RC[2]" End If Next I

Ý em là không muốn hiển thị công thức trong cell ý

Ba Tê · 27/5/20

Duong.bach đã viết:
Ý em là không muốn hiển thị công thức trong cell ý

Bài đã được tự động gộp: 27/5/20

Ý em là không muốn hiển thị công thức trong cell ý

Vậy là bạn chỉ đọc và "hiểu" code chứ chưa thử?

Duong.bach · 27/5/20

Ba Tê đã viết:
Dạng applitcation là sao?
Ý muốn này chỉ có thể trở về cách For... Next

PHP:

For I = DòngĐầu To DòngCuối If Range("B" & I) + Range("C" & I) > 0 Then Range("A" & I) = "=RC[1]+RC[2]" End If Next I

Em sửa như này sao lại lỗi ạ ?
For I = DòngĐầu To DòngCuối
If Range("B" & I) + Range("C" & I) > 0 Then
Range("A" & I) = range("B"& i ).value + range("C"& i ).value
End If
Next I

Bài đã được tự động gộp: 27/5/20

Ba Tê đã viết:
Vậy là bạn chỉ đọc và "hiểu" code chứ chưa thử?

Em thử rồi, nhưng trong cell có giá trị thực tế vẫn là công thức, tất nhiên cách của bác đã gần đúng với mong muốn của em nhất, nhưng nếu k hiện công thức thì trông nó càng pro hơn

.

Ba Tê · 27/5/20

Duong.bach đã viết:
Em sửa như này sao lại lỗi ạ ?
For I = DòngĐầu To DòngCuối
If Range("B" & I) + Range("C" & I) > 0 Then
Range("A" & I) = range("B"& i ).value + range("C"& i ).value
End If
Next I

Bài đã được tự động gộp: 27/5/20

Em thử rồi, nhưng trong cell có giá trị thực tế vẫn là công thức, tất nhiên cách của bác đã gần đúng với mong muốn của em nhất, nhưng nếu k hiện công thức thì trông nó càng pro hơn .

Bạn phải gán DòngĐầu = bao nhiêu, Dòng Cuối = bao nhiêu chứ. Ví dụ For I=10 to 30
Tôi chỉ là gợi ý thôi chứ bạn bê nguyên xi thì ai biết DòngĐầu là cái quái gì.
Muốn dọn sạch cột A trước khi chạy code thì bạn thêm dòng lệnh này trước vòng For

PHP:

Range("A" & DongDau & ":A" & DongCuoi).Clearcontents   'Them dong nay'
For I = DongDau To DongCuoi
   If Range("B" & I) + Range("C" & I) > 0 Then
      Range("A" & I).Value = Range("B" & I).Value + Range("C" & I).Value
   End If
Next I

Tôi không hiểu được, "k", "pro" là gì.

ppc0312 · 27/5/20

Ba Tê đã viết:
Bạn phải gán DòngĐầu = bao nhiêu, Dòng Cuối = bao nhiêu chứ. Ví dụ For I=10 to 30
Tôi chỉ là gợi ý thôi chứ bạn bê nguyên xi thì ai biết DòngĐầu là cái quái gì.
Muốn dọn sạch cột A trước khi chạy code thì bạn thêm dòng lệnh này trước vòng For

PHP:

Range("A" & DongDau & ":A" & DongCuoi).Clearcontents 'Them dong nay' For I = DongDau To DongCuoi If Range("B" & I) + Range("C" & I) > 0 Then Range("A" & I) = "=RC[1]+RC[2]" End If Next I

Tôi không hiểu được, "k", "pro" là gì.

Đúng là kk thì chắc bác sẽ hiểu
Nhưng không hiểu mà bác vẫn làm?

VetMini · 27/5/20

ppc0312 đã viết:
Đúng là kk thì chắc bác sẽ hiểu
Nhưng không hiểu mà bác vẫn làm?

Tiếng lóng và tiếng Tây bồi nó rắc rối lắm. Không hiểu tức là không hiểu người ta móc mình hay còn ẩn ý gì khác.
Nhất là khi gặp tiếng Tây bồi. Có những trường hợp hiểu theo đúng ngữ cảnh tiếng Tây thì nó là nói móc, mà mình thì không biết là người dùng cố tình hay do dốt tiếng Tây.

Chú: Từ kk, kaka, là cách nói trại của caca tiếng Pháp thời tôi còn nhỏ, và có nghĩa là chửi tục.

Duong.bach · 27/5/20

Ba Tê đã viết:
Bạn phải gán DòngĐầu = bao nhiêu, Dòng Cuối = bao nhiêu chứ. Ví dụ For I=10 to 30
Tôi chỉ là gợi ý thôi chứ bạn bê nguyên xi thì ai biết DòngĐầu là cái quái gì.
Muốn dọn sạch cột A trước khi chạy code thì bạn thêm dòng lệnh này trước vòng For

PHP:

Range("A" & DongDau & ":A" & DongCuoi).Clearcontents 'Them dong nay' For I = DongDau To DongCuoi If Range("B" & I) + Range("C" & I) > 0 Then Range("A" & I) = "=RC[1]+RC[2]" End If Next I

Tôi không hiểu được, "k", "pro" là gì.

Em nhầm, em có thay dòng đầu và dòng cuối rồi, nhưng em lại add code vào worksheet_change nên nó báo lỗi.
Còn em có viết KK gì đâu nhỉ, hay em viết ": D" nó lại hiện là kK. còn pro thì tất nhiên là trông nó chuyên nghiệp rồi.
Sau khi kết hợp ideal của mọi người thì em cũng hoàn thành được mòng muốn của mình với cái code này. Thanks all
For i = 1 To 50
Application.EnableEvents = False
If Range("B" & i) + Range("C" & i) <> 0 Then
Range("A" & i) = Range("B" & i).Value + Range("C" & i).Value
End If
Next i
Application.EnableEvents = True

SweetCandyt · 28/5/20

Em chào anh chị ạ. Em có thực hiện file VBA bằng cách Record Marco, khi chạy file báo lỗi đoạn code lệnh Privot Table.
Anh chị coi giúp em với ạ. Em cảm ơn anh chị ạ
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"So sanh chi tiet!R2C1:R1471C28", Version:=xlPivotTableVersion14). _
CreatePivotTable TableDestination:="So sanh tong hop!R1:R1048576", TableName _
:="PivotTable2", DefaultVersion:=xlPivotTableVersion14

domjnjc · 29/5/20

File dưới e tham khảo của một pro trong forum về cách tạo ngẫu nhiên dữ liệu số ngẫu nhiên không trùng, em thêm được đoạn mã chạy tự động sau mỗi 10s, nhưng mục đích của em cuối cùng là: cứ sau 10s, Sub tự động chạy cho đến khi H1 đến J1 hiển thị giá trị "true" thì dừng lại 30s, nhờ các pro giúp e với ạ!


Sub Test()
  Range("A1:A30").Value = UniqueRandomNum(1, 1000, 30)
    alertTime = Now + TimeValue("00:00:10")
    Application.OnTime alertTime, "Test"
End Sub
Function UniqueRandomNum(Bottom As Long, Top As Long, Amount As Long)
  'Application.Volatile '<--- Neu muon gia tri thay doi khi bam F9
  On Error Resume Next
  If Amount > Top - Bottom + 1 Then Amount = Top - Bottom + 1
  With CreateObject("Scripting.Dictionary")
    Do
      .Add Int(Rnd() * (Top - Bottom + 1)) + Bottom, ""
    Loop Until .Count = Amount
    UniqueRandomNum = WorksheetFunction.Transpose(.Keys)
  End With
End Function

CHAOQUAY · 29/5/20

domjnjc đã viết:
File dưới e tham khảo của một pro trong forum về cách tạo ngẫu nhiên dữ liệu số ngẫu nhiên không trùng, em thêm được đoạn mã chạy tự động sau mỗi 10s, nhưng mục đích của em cuối cùng là: cứ sau 10s, Sub tự động chạy cho đến khi H1 đến J1 hiển thị giá trị "true" thì dừng lại 30s, nhờ các pro giúp e với ạ!

Sub Test() Range("A1:A30").Value = UniqueRandomNum(1, 1000, 30) alertTime = Now + TimeValue("00:00:10") Application.OnTime alertTime, "Test" End Sub Function UniqueRandomNum(Bottom As Long, Top As Long, Amount As Long) 'Application.Volatile '<--- Neu muon gia tri thay doi khi bam F9 On Error Resume Next If Amount > Top - Bottom + 1 Then Amount = Top - Bottom + 1 With CreateObject("Scripting.Dictionary") Do .Add Int(Rnd() * (Top - Bottom + 1)) + Bottom, "" Loop Until .Count = Amount UniqueRandomNum = WorksheetFunction.Transpose(.Keys) End With End Function

Chạy đến khi nào thì thôi?

PacificPR · 29/5/20

CHAOQUAY đã viết:
Chạy đến khi nào thì thôi?

Dạ đến khi tắt Excel ạ

CHAOQUAY · 29/5/20

PacificPR đã viết:
Dạ đến khi tắt Excel ạ

Cái bài nghỉ 10s, tiếp tục, rồi lại 10s tiếp nghe giống như là búa máy đóng cọc ý bạn nhỉ

domjnjc · 29/5/20

CHAOQUAY đã viết:
Chạy đến khi nào thì thôi?

Dạ, chạy mãi mãi ạ, kiểu như chỉ tạm dừng 30s khi các ô từ H1 đến J1 có xuất hiện "true" ạ

CHAOQUAY · 29/5/20

domjnjc đã viết:
Dạ, chạy mãi mãi ạ, kiểu như chỉ tạm dừng 30s khi các ô từ H1 đến J1 có xuất hiện "true" ạ

Sửa lại 1 tí cho nhanh.
Bạn có thể sửa lại giá trị của tm = bao nhiêu thì tùy.
Cái này nếu thích dừng có thể nhấn phím Esc

Mã:

#If VBA7 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
#Else
Public Declare Sub Sleep Lib "kernel32" (ByVal Milliseconds As Long)
#End If


Sub Test()
Dim tm

Range("A1:A30").Value = UniqueRandomNum(1, 1000, 30)
tm = 100
If Range("H1") = True Then
    If Range("I1") = True Then
        If Range("J1") = True Then
            tm = 300
        End If
    End If
End If
Sleep (tm)
Test

'alertTime = Now + TimeValue("00:00:10")
'Application.OnTime alertTime, "Test"

End Sub
Function UniqueRandomNum(Bottom As Long, Top As Long, Amount As Long)
  'Application.Volatile '<--- Neu muon gia tri thay doi khi bam F9
  On Error Resume Next
  If Amount > Top - Bottom + 1 Then Amount = Top - Bottom + 1
  With CreateObject("Scripting.Dictionary")
    Do
      .Add Int(Rnd() * (Top - Bottom + 1)) + Bottom, ""
    Loop Until .Count = Amount
    UniqueRandomNum = WorksheetFunction.Transpose(.Keys)
  End With
End Function

domjnjc · 30/5/20

CHAOQUAY đã viết:

Sửa lại 1 tí cho nhanh.
Bạn có thể sửa lại giá trị của tm = bao nhiêu thì tùy.
Cái này nếu thích dừng có thể nhấn phím Esc

Mã:

#If VBA7 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
#Else
Public Declare Sub Sleep Lib "kernel32" (ByVal Milliseconds As Long)
#End If


Sub Test()
Dim tm

Range("A1:A30").Value = UniqueRandomNum(1, 1000, 30)
tm = 100
If Range("H1") = True Then
    If Range("I1") = True Then
        If Range("J1") = True Then
            tm = 300
        End If
    End If
End If
Sleep (tm)
Test

'alertTime = Now + TimeValue("00:00:10")
'Application.OnTime alertTime, "Test"

End Sub
Function UniqueRandomNum(Bottom As Long, Top As Long, Amount As Long)
  'Application.Volatile '<--- Neu muon gia tri thay doi khi bam F9
  On Error Resume Next
  If Amount > Top - Bottom + 1 Then Amount = Top - Bottom + 1
  With CreateObject("Scripting.Dictionary")
    Do
      .Add Int(Rnd() * (Top - Bottom + 1)) + Bottom, ""
    Loop Until .Count = Amount
    UniqueRandomNum = WorksheetFunction.Transpose(.Keys)
  End With
End Function

Em cảm ơn nhiều ạ, nhưng khi em ấn vào nút button click thì chỉ chay liện tục mà không dừng lại khi H1 hiện true a ạ, còn không bấm vào button thì không thấy tự động chọn ngẫu nhiên tập số sau 10s ạ,
Nếu không được thì em muốn nó chạy đến khi ô H1 xuất hiện giá trị true thì dừng hẳn, a giúp e với ạ!

CHAOQUAY · 30/5/20

domjnjc đã viết:
Em cảm ơn nhiều ạ, nhưng khi em ấn vào nút button click thì chỉ chay liện tục mà không dừng lại khi H1 hiện true a ạ, còn không bấm vào button thì không thấy tự động chọn ngẫu nhiên tập số sau 10s ạ

Bạn bấm vào thì nó mới chạy. Ít nhất phải bấm 1 lần.
Theo yêu cầu màu xanh của bài trước, khi H1=true & I1=true & J1=true thì sẽ dừng lâu hơn.
Có phải ý của bạn như phần chữ xanh?

domjnjc đã viết:
File dưới e tham khảo của một pro trong forum về cách tạo ngẫu nhiên dữ liệu số ngẫu nhiên không trùng, em thêm được đoạn mã chạy tự động sau mỗi 10s, nhưng mục đích của em cuối cùng là: cứ sau 10s, Sub tự động chạy cho đến khi H1 đến J1 hiển thị giá trị "true" thì dừng lại 30s, nhờ các pro giúp e với ạ!

Bài đã được tự động gộp: 30/5/20

domjnjc đã viết:
Nếu không được thì em muốn nó chạy đến khi ô H1 xuất hiện giá trị true thì dừng hẳn, a giúp e với ạ!

Mã:

If Range("H1") = True Then

Nếu vậy bạn tìm dòng bên trên.
Chèn thêm phía dưới dòng lệnh dưới đây

Mã:

Exit Sub

domjnjc · 30/5/20

CHAOQUAY đã viết:
Bạn bấm vào thì nó mới chạy. Ít nhất phải bấm 1 lần.
Theo yêu cầu màu xanh của bài trước, khi H1=true & I1=true & J1=true thì sẽ dừng lâu hơn.
Có phải ý của bạn như phần chữ xanh?

Dạ, chỉ cần bất cứ 1 ô nào trong 3 ô H1,I1, J1 hiển thị giá trị true thì dừng lâu hơn 30s, em thay thế bằng OR được rồi ạ

CHAOQUAY đã viết:
Nếu vậy bạn tìm dòng bên trên.
Chèn thêm phía dưới dòng lệnh dưới đây

Dạ em cảm ơn, em làm được rồi ạ

Cu Tồ · 30/5/20

Mã:

Sub mo_file()
Workbooks.Open Filename:=Range("F9"), Password:=Range("G9")
End Sub

chào anh chị em trong diễn đàn GPE
các anh chị cho mình hỏi là trong đoạn code dưới đây thì sửa làm sao để nó tự nhập mật khẩu ở ô G9 ạ?

BlackHorse1123 · 10/6/20

Các bác có thể cho em đoạn code lưu 1 vùng chọn trong exel thành 1 sheet mới trong 1 trang tính khác được không ạ. Em mấy hôm tìm mãi mà không thấy. :'(

Kiều Mạnh · 13/6/20

Các Bạn cho mình hỏi chút
Có cách nào chỉ cho nhập vào TextBox1 thủ công giá trị tương đương với địa chỉ ô trên bảng tính bất kỳ không ??

1/ Giá trị trong TextBox1 là địa chỉ ô bất kỳ trên bảng tính, do mình nhập thủ công
2/ Nếu nhập vào TextBox1 sai so với địa chỉ ô bất kỳ trên bảng tính báo lỗi hay Xóa
3/ Viết code check cái giá trị nhập thủ công trên TextBox1
================
VD nhập Sai: 11, aaa, mmm
VD nhập đúng: A1 To A1048576, hay B1 to B1048576 ...

Code kiểu như sau mà mình chưa hình dung ra cách viết và xử lý lỗi

Mã:

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Rem chi cho nhap vào TextBox1 giá tri tuong duong dia chi Cells tren Sheet
    If TextBox1.Value <> Range("????") Then
        TextBox1.Value = Empty
    Else
        Exit Sub
    End If
End Sub

Rất mong sự trợ giúp
xin cảm ơn

ongke0711 · 13/6/20

Có 1 cách là bạn tách chữ và số: comboBox cho chữ, textbox cho số. Khi đó bạn có thể đưa danh sách các ký tự cột của bảng tính Exce làm Row Source cho comboBoxl, Textbox thì số thì không lớn hơn 1.048.576

HieuCD · 13/6/20

Kiều Mạnh đã viết:
Các Bạn cho mình hỏi chút
Có cách nào chỉ cho nhập vào TextBox1 thủ công giá trị tương đương với địa chỉ ô trên bảng tính bất kỳ không ??

1/ Giá trị trong TextBox1 là địa chỉ ô bất kỳ trên bảng tính, do mình nhập thủ công
2/ Nếu nhập vào TextBox1 sai so với địa chỉ ô bất kỳ trên bảng tính báo lỗi hay Xóa
3/ Viết code check cái giá trị nhập thủ công trên TextBox1
================
VD nhập Sai: 11, aaa, mmm
VD nhập đúng: A1 To A1048576, hay B1 to B1048576 ...

Code kiểu như sau mà mình chưa hình dung ra cách viết và xử lý lỗi

Mã:

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Rem chi cho nhap vào TextBox1 giá tri tuong duong dia chi Cells tren Sheet If TextBox1.Value <> Range("????") Then TextBox1.Value = Empty Else Exit Sub End If End Sub

Rất mong sự trợ giúp
xin cảm ơn

Ví dụ

Mã:

On Error Resume Next
a = TypeName(Range(TextBox1.Value))
If Err > 1 Then 'Lổi
  '...
  On Error GoTo 0
End If

Kiều Mạnh · 13/6/20

HieuCD đã viết:
HieuCD đã viết:

Ví dụ

Mã:

On Error Resume Next a = TypeName(Range(TextBox1.Value)) If Err > 1 Then 'Lổi '... On Error GoTo 0 End If

Nhấp chuột vào đây để mở rộng...

Ví dụ

Mã:

On Error Resume Next a = TypeName(Range(TextBox1.Value)) If Err > 1 Then 'Lổi '... On Error GoTo 0 End If

Mai thứ xem sao đang trên điện thoại

ptm0412 · 14/6/20

Kiều Mạnh đã viết:
Các Bạn cho mình hỏi chút
Có cách nào chỉ cho nhập vào TextBox1 thủ công giá trị tương đương với địa chỉ ô trên bảng tính bất kỳ không ??

Đưa vào sự kiện BeforeUpdate. Dùng sự kiện KeyDown thì vừa nhấn phím ký tự đầu tiên đã bị chửi. sự kiện BeforeUpdate còn có tham số Cancel cho phép buộc ở lại để sửa nếu sai

PHP:

Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    On Error GoTo Loi
    Set Rng = ActiveSheet.Range(TextBox1.Value)
    Set Rng = Nothing: Exit Sub
Loi:
    MsgBox "Do chet tiet! Không phai dia chi o."
    Cancel = True
    Exit Sub
End Sub

Kiều Mạnh · 14/6/20

ptm0412 đã viết:
Đưa vào sự kiện BeforeUpdate. Dùng sự kiện KeyDown thì vừa nhấn phím ký tự đầu tiên đã bị chửi. sự kiện BeforeUpdate còn có tham số Cancel cho phép buộc ở lại để sửa nếu sai

PHP:

Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) On Error GoTo Loi Set Rng = ActiveSheet.Range(TextBox1.Value) Set Rng = Nothing: Exit Sub Loi: MsgBox "Do chet tiet! Không phai dia chi o." Cancel = True Exit Sub End Sub

Em mới thử xong kiểu gì nó củng IM RE hết

ptm0412 · 14/6/20

Kiều Mạnh đã viết:
Em mới thử xong kiểu gì nó củng IM RE hết

Tại có duy nhất 1 control nên không xảy ra sự kiện

(có đi đâu đâu mà buộc ở lại)
Vẽ thêm 1 control bất kỳ đi
Có vậy mà like xong đành đoạn gỡ ra

Kiều Mạnh · 14/6/20

ptm0412 đã viết:
Tại có duy nhất 1 control nên không xảy ra sự kiện (có đi đâu đâu mà buộc ở lại)
Vẽ thêm 1 control bất kỳ đi
Có vậy mà like xong đành đoạn gỡ ra

Chính xác cái Em cần ... Mà tiện cho Em hỏi chút mà cớ sao phải cho 2 control trở lên nó mới có tác dụng là sao ???!!!!!!!!

ptm0412 · 14/6/20

Kiều Mạnh đã viết:
Chính xác cái Em cần ... Mà tiện cho Em hỏi chút mà cớ sao phải cho 2 control trở lên nó mới có tác dụng là sao ???!!!!!!!!

Các sự kiện Before update, after update, enter, exit của 1 control (loại nhập liệu) chỉ xảy ra khi vào hoặc ra khỏi control. Phải có control thứ 2 mới có chuyện từ đâu vào hoặc ra rồi đi đâu chứ?
Thí dụ như bị nhốt trong nhà (chung quanh không có gì hết) thì làm gì có chuyện mở cửa đi chơi hay về mở cửa vào nhà

BuiQuangThuan · 18/6/20

Em xin chào các thầy cô, anh chị trên diễn đàn.
Có 1 thắc mắc này nhờ mọi người trả lời giúp được không ạ?

1. Hiện tại em đang muốn duyệt qua từng file được chọn ( Ví dụ kích vô nút nó sẽ hiện lên đường dẫn foder => chọn những file muốn chọn).

Sau đó nó sẽ mở từ file lên và đưa vùng dữ liệu (vùng này cũng được khai báo trước) trong 1 sheet chỉ định vào mảng.
Mỗi 1 file mở lên sẽ được tạo thành 1 mảng riêng biệt ( Chẳng hạn em chọn 3 file, thì nó sẽ tạo ra 3 mảng Arr trong Locals).

2. Nếu như làm được 1. Vùng dữ liệu và tên sheet lấy dữ liệu trong file con sẽ khai báo bằng biến trước được không ạ?

Do đây là cách em nghĩ. Không biết có khả thi không? Nên mạn phép nhờ thầy cô và mọi người chỉ giúp ạ.
Em xin cám ơn!

Hoàng Nhật Phương · 22/6/20

Xin chào các bạn:
Hiện OT mong muốn sau khi chạy được dữ liệu sẽ xuất ra được kết quả là:

Mã:

INSERT INTO TABLE_NAME (Col1,Col2,Col3,Col4,Col5) VALUES
(Col1_data1,Col2_data1,Col3_data1,Col4_data1,Col5_data1),
(Col1_data2,Col2_data2,Col3_data2,Col4_data2,Col5_data2),
(Col1_data3,Col2_data3,Col3_data3,Col4_data3,Col5_data3),
(Col1_data4,Col2_data4,Col3_data4,Col4_data4,Col5_data4),
(Col1_data5,Col2_data5,Col3_data5,Col4_data5,Col5_data5)

Nhưng OT đã loay hoay suốt với đoạn code bên dưới , kết quả ra xuất ra không mong muốn, các dấu ngoặc "(" không xen kẽ sau các dấu "," như trên :

Mã:

INSERT INTO TABLE_NAME (Col1,Col2,Col3,Col4,Col5) VALUES
(((((Col1_data1,Col2_data1,Col3_data1,Col4_data1,Col5_data1),
Col1_data2,Col2_data2,Col3_data2,Col4_data2,Col5_data2),
Col1_data3,Col2_data3,Col3_data3,Col4_data3,Col5_data3),
Col1_data4,Col2_data4,Col3_data4,Col4_data4,Col5_data4),
Col1_data5,Col2_data5,Col3_data5,Col4_data5,Col5_data5)

Nhờ các bạn sửa giúp đoạn code trên cho OT với ạ.

Mã:

Option Explicit

Sub Test()

    Dim sh As Worksheet, arr As Variant, s As String
    Dim I As Long, J As Long, cName As String, iData As String
    Set sh = ThisWorkbook.Worksheets("DL")
    
    arr = sh.Range("D1").Resize(6, 5).Value2
    For J = 1 To UBound(arr, 2)
        If J = 1 Then
            cName = arr(1, J)
        Else
            cName = cName & "," & arr(1, J)
        End If
    Next J
          
    For I = 2 To UBound(arr, 1)
        For J = 1 To UBound(arr, 2)
            s = arr(I, J)
            If J = 1 And I = 2 Then
                iData = s
            Else
                iData = iData & "," & s
            End If
        Next J
        iData = "(" & iData & ")"
    Next I

    s = "INSERT INTO TABLE_NAME (" & cName & ") VALUES " & iData
    
    Debug.Print s
          
End Sub

Hoàng Nhật Phương · 22/6/20

Nguyễn Hoàng Nhật Phương đã viết:

Xin chào các bạn:
Hiện OT mong muốn sau khi chạy được dữ liệu sẽ xuất ra được kết quả là:

Mã:

INSERT INTO TABLE_NAME (Col1,Col2,Col3,Col4,Col5) VALUES
(Col1_data1,Col2_data1,Col3_data1,Col4_data1,Col5_data1),
(Col1_data2,Col2_data2,Col3_data2,Col4_data2,Col5_data2),
(Col1_data3,Col2_data3,Col3_data3,Col4_data3,Col5_data3),
(Col1_data4,Col2_data4,Col3_data4,Col4_data4,Col5_data4),
(Col1_data5,Col2_data5,Col3_data5,Col4_data5,Col5_data5)

Nhưng OT đã loay hoay suốt với đoạn code bên dưới , kết quả ra xuất ra không mong muốn, các dấu ngoặc "(" không xen kẽ sau các dấu "," như trên :

Mã:

INSERT INTO TABLE_NAME (Col1,Col2,Col3,Col4,Col5) VALUES
(((((Col1_data1,Col2_data1,Col3_data1,Col4_data1,Col5_data1),
Col1_data2,Col2_data2,Col3_data2,Col4_data2,Col5_data2),
Col1_data3,Col2_data3,Col3_data3,Col4_data3,Col5_data3),
Col1_data4,Col2_data4,Col3_data4,Col4_data4,Col5_data4),
Col1_data5,Col2_data5,Col3_data5,Col4_data5,Col5_data5)

Nhờ các bạn sửa giúp đoạn code trên cho OT với ạ.

Mã:

Option Explicit

Sub Test()

    Dim sh As Worksheet, arr As Variant, s As String
    Dim I As Long, J As Long, cName As String, iData As String
    Set sh = ThisWorkbook.Worksheets("DL")
   
    arr = sh.Range("D1").Resize(6, 5).Value2
    For J = 1 To UBound(arr, 2)
        If J = 1 Then
            cName = arr(1, J)
        Else
            cName = cName & "," & arr(1, J)
        End If
    Next J
         
    For I = 2 To UBound(arr, 1)
        For J = 1 To UBound(arr, 2)
            s = arr(I, J)
            If J = 1 And I = 2 Then
                iData = s
            Else
                iData = iData & "," & s
            End If
        Next J
        iData = "(" & iData & ")"
    Next I

    s = "INSERT INTO TABLE_NAME (" & cName & ") VALUES " & iData
   
    Debug.Print s
         
End Sub

Cảm ơn mọi người OT đã xử lý được rồi ạ, mặc dù nó hơi dài ạ:

Mã:

...
    For I = 2 To UBound(arr, 1)
        For J = 1 To UBound(arr, 2)
            s = arr(I, J)
            If J = 1 And I = 2 Then
                iData = "(" & s
            ElseIf J = 1 Then
                iData = iData & ",(" & s
            Else
                iData = iData & "," & s
            End If
        Next J
        iData = iData & ")"
    Next I
    ...

Nếu Bạn nào có cách làm khác cho OT tham khảo với ạ.

Chuyên đề giải đáp những thắc mắc về code VBA (6 người xem)

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

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

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

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

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

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

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!!!

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

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

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

Thành viên gắn bó

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

|||||||||||||

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

Thành viên gắn bó

Thành viên hoạt động

Thành viên gắn bó

Thành viên hoạt động

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

Thành viên gắn bó

Thành viên hoạt động

File đính kèm

Thành viên gắn bó

Thành viên mới

Thành viên hoạt động

File đính kèm

Thành viên mới

Thành viên mới

File đính kèm

Thành viên gắn bó

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

/(hông là gì!

Thành viên gắn bó

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

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

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

Thành viên gắn bó

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

/(hông là gì!

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

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

whom?

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

Thành viên gắn bó

File đính kèm

Thành viên gắn bó

Thành viên gắn bó

Thành viên gắn bó

Thành viên gắn bó

Thành viên gắn bó

Thành viên gắn bó

Thành viên tích cực

Thành viên gắn bó

Thành viên gắn bó

Chuyên gia GPE

Thành viên gắn bó

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

Thành viên mới

File đính kèm

==(^o^)==

Thành viên mới

==(^o^)==

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

Thành viên mới

Thành viên mới

==(^o^)==

Thành viên mới

Thành viên mới

Thành viên gắn bó

Thành viên mới

/(hông là gì!

Thành viên mới