Chuyên đề giải đáp những thắc mắc về code VBA (3 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]

langtuchungtinh360 · 23/5/17

chào mọi người
mọi người cho mình hỏi vấn đề thế này
ví dụ có 1 sheet tên "A-B" khi sử dụng code Sheets("A-B").codename thì bị lỗi 1004 do có ký tự đặc biệt "-"
vậy làm sao để thao tác với những sheet có ký tự đặc biệt như thế.
không dùng kiểu Sheets(1).codename nhé.
cảm ơn mọi người.

HieuCD · 23/5/17

langtuchungtinh360 đã viết:
chào mọi người
mọi người cho mình hỏi vấn đề thế này
ví dụ có 1 sheet tên "A-B" khi sử dụng code Sheets("A-B").codename thì bị lỗi 1004 do có ký tự đặc biệt "-"
vậy làm sao để thao tác với những sheet có ký tự đặc biệt như thế.
không dùng kiểu Sheets(1).codename nhé.
cảm ơn mọi người.

máy mình vẫn bình thường không bị lỗi: test=Sheets("A-B").codename

langtuchungtinh360 · 23/5/17

HieuCD đã viết:
máy mình vẫn bình thường không bị lỗi: test=Sheets("A-B").codename

vậy hỏi mà chưa test trước rồi :v
thử lại cái này he bạn
tạo 2 sheet 1 sheet tên "Sheet1" 1 sheet tên "A-B"
thử code này xem

Mã:

Sub Test()
MsgBox Range("Sheet1!A1").Column
MsgBox Range("A-B!A1").Column'<lỗi 1004
End Sub

tương tự nếu thay "-" thành " "

ndu96081631 · 23/5/17

langtuchungtinh360 đã viết:
vậy hỏi mà chưa test trước rồi :v
thử lại cái này he bạn
tạo 2 sheet 1 sheet tên "Sheet1" 1 sheet tên "A-B"
thử code này xem

Mã:

Sub Test() MsgBox Range("Sheet1!A1").Column MsgBox Range("A-B!A1").Column'<lỗi 1004 End Sub

tương tự nếu thay "-" thành " "

Với tên sheet hơi "lạ", ta nên cho cặp dấu nháy đơn vào trước và sau tên sheet:
Sub Test()
MsgBox Range("'A-B'!A1").Column
End Sub

NguyenNgocThuHien · 23/5/17

Em có đoạn code như dưới, mà chưa hiểu tại sao nó lại hiện ra hai hộp thoại với nội dung giống nhau, theo em nghĩ nó phải khác nhau. Mong mọi người giải thích giúp.

Mã:

Sub thu()
    Dim c As Collection
    Set c = New Collection
    c.Add 1
    c.Add 2
    MsgBox Hex(VarPtr(c.Item(1)))
    c.Add 3
    MsgBox Hex(VarPtr(c.Item(2)))
    
End Sub

langtuchungtinh360 · 23/5/17

cho em hỏi thêm

Mã:

Sub checksListFormat()
    Dim oShell As Object
    Dim sList
    Set oShell = CreateObject("wscript.shell")
    sList = oShell.RegRead("HKEY_CURRENT_USER\Control Panel\International\sList")
    MsgBox sList
    oShell.RegWrite "HKEY_CURRENT_USER\Control Panel\International\sList", IIf(sList = ",", ";", ",")
    sList = oShell.RegRead("HKEY_CURRENT_USER\Control Panel\International\sList")
    MsgBox sList
End Sub

dùng để đổi dấu slist Separator qua lại giữa dấu chấm phẩy và dấu phẩy ( ngăn cách các biến số trong công thức)
code có tác dụng vào resgedit, vào control panel xem thì có thấy sự thay đổi của tham số slist Separator
nhưng còn trên excel vẫn như cũ. vậy làm sao để code có tác dụng ngay được ạ.
==================================
cụ thể ban đầu là dấu chấm phẩy
sau khi chạy code thì slist Separator là dấu phẩy
nhưng công thức thì vẫn là dấu chấm phẩy, không đổi thành dấu phẩy được

keke355992 · 28/5/17

Các bạn Cho mình hỏi ADO giới hạn truy vấn số cột là 256 và số dòng 65536 phải ko nhỉ ? Xin cảm ơn !

ndu96081631 · 28/5/17

keke355992 đã viết:
Các bạn Cho mình hỏi ADO giới hạn truy vấn số cột là 256 và số dòng 65536 phải ko nhỉ ? Xin cảm ơn !

Hình như là vậy!
Tuy nhiên bạn có thể thí nghiệm trực tiếp trên dữ liệu để kiểm chứng (thay vì hỏi và chờ trả lời)

keke355992 · 28/5/17

ndu96081631 đã viết:
Hình như là vậy!
Tuy nhiên bạn có thể thí nghiệm trực tiếp trên dữ liệu để kiểm chứng (thay vì hỏi và chờ trả lời)

E thí nghiệm rùi ạ. Nhg vẫn lên hỏi lại cho chắc, vì sợ code mình sai

VetMini · 28/5/17

Thí nghiệm bằng cái gì?
ADO là một công cụ của Windows. Giới hạn tuỳ theo cái cổ máy (engine) mà chuỗi kết nối bảo nó dùng.

nam855 · 28/5/17

chào mọi người. tình hình là thầy giáo giao cho em nhiệm vụ lập trình vba để nhúng phần mềm thứ 3 là sap2000 để điều kiển sap2000? vậy cho e hỏi như thế có thể làm được không ạ? và độ khó cho 1 người chưa biết về vba là thế nào ạ? Em cảm ơn mọi người, hi vọng mọi người góp ý ạ!!!

nhamgtvt · 29/5/17

E có xem 1 code VBA nội suy 2 chiều , lần đầu xem chưa có kiến thức nhiều , mong a/c giải đáp 1 số thắc mắc như sau ạ
Code chỗ mục Modules là để phục vụ cho code trong Sheet excel phải k ạ ?
Ở ví dụ code nội suy 2 chiều, tác giả viết phần code Module:

Mã:

Function ns1(x, X1, X2, GT1, GT2)
    TG = GT2 + (GT1 - GT2) * (x - X2) / (X1 - X2)
    ns1 = TG
End Function
Function NSM(x, y, MANGZ)
    hang = 1
    Cot = 1
    For i = 1 To 100
        If MANGZ(i, 1) <> "" Then hang = hang + 1
        If MANGZ(i, 1) = 35 Then i = 50
    Next i
    For j = 1 To 100
        If MANGZ(1, j) <> "" Then Cot = Cot + 1
    Next j

    For i = 1 To hang
        If x <= MANGZ(i, 1) Then
        X1 = MANGZ(i, 1)
        X2 = MANGZ(i - 1, 1)
        VTX = i
        i = hang
        End If
    Next i
    For j = 1 To Cot
        If y <= MANGZ(1, j) Then
        Y1 = MANGZ(1, j)
        Y2 = MANGZ(1, j - 1)
        VTY = j
        j = Cot
        End If
    Next j
    x1y1 = MANGZ(VTX, VTY)
    x1y2 = MANGZ(VTX, VTY - 1)
    x2y1 = MANGZ(VTX - 1, VTY)
    x2y2 = MANGZ(VTX - 1, VTY - 1)
    'NOI SUY
    t3 = ns1(y, Y1, Y2, x2y1, x2y2)
    T4 = ns1(y, Y1, Y2, x1y1, x1y2)
    NSM = ns1(x, X1, X2, T4, t3)
End Function

Ở phần code sheet :

Mã:

Private Sub noisuy2chieu_Click()

i = 8
While Sheet1.Cells(i, "D") <> ""

 Ketqua = NSM(Sheet1.Cells(i, "D"), Sheet1.Cells(i, "E"), Sheet1.Range("H9:O16"))
 Sheet1.Cells(i, "F") = Ketqua

i = i + 1
Wend

End Sub

Mong a/c nào có thể dịch từng câu lệnh, cú pháp để e hiểu hơn được không ạ.

keke355992 · 30/5/17

VetMini đã viết:
Thí nghiệm bằng cái gì?
ADO là một công cụ của Windows. Giới hạn tuỳ theo cái cổ máy (engine) mà chuỗi kết nối bảo nó dùng.

E thí nghiệm trong môi trường Excel 2013,mệnh đề From Vung - Range("A5:C65537") --> Báo lỗi. Nhưng sửa thành Range("A5:C65536") thì chạy bình thường.
E có đọc được bài viết của thầy NDU trong Bài tập ADO căn bản của A Hai Lúa Miền Tây và các bài tiếp theo: http://www.giaiphapexcel.com/diendan/threads/bài-tập-về-ado-căn-bản.75143/page-6
Nhưng có thắc mắc: Có phải với Name bình thường sẽ bị giới hạn trong phạm vi 65536 dòng, nhưng đã có giải pháp để tăng truy vấn lên tận 500.000 dòng và hơn thế nữa. Phải chăng ADO bị giới hạn với 1 name đặt Thủ công như cách của e .

VetMini · 30/5/17

Bài đó đã hơn 4 năm rồi. Trong khoảng thời gian đó có nhiều thay đổi và cải tiến công nghệ.

VetMini · 30/5/17

nhamgtvt đã viết:
Mong a/c nào có thể dịch từng câu lệnh, cú pháp để e hiểu hơn được không ạ.

Mói học code thì tìm những bài có chú thích rõ ràng mà học.
Mấy cái code này tác giả khong có cho biết mình dùng giải thuật gì, tôi khong thể kiểm chứng viết như vậy là đúng hay sai cho nên lười đọc và giải thích lắm.

Ví dụ đáng lẽ phảí tính A+B, tác giả viết sai thành A-B thì tìm cả ngày cũng chưa chắc ra.

keke355992 · 30/5/17

VetMini đã viết:
Bài đó đã hơn 4 năm rồi. Trong khoảng thời gian đó có nhiều thay đổi và cải tiến công nghệ.

Cảm ơn A. E đag pải tìm hiểu dần ạ. Phải đi từ cái 4 năm trước mới được ý, chứ theo công nghệ tại thời điểm này thì chạy k nổi

keke355992 · 30/5/17

Tiện đây, nhờ a @VetMini xem giúp e bài này. sử dụng hàm sumifs trong VBA, k hiểu điều kiện sai ở chỗ nào mà ko ra đc kết quả

VetMini · 30/5/17

Bạn copy code đưa lên, và cho biết code làm cái gì. Tôi đọc lô gic của code trước và chỉ tải file về khi cần kiểm chứng đúng sai.

NguyenNgocThuHien · 30/5/17

keke355992 đã viết:
Tiện đây, nhờ a @VetMini xem giúp e bài này. sử dụng hàm sumifs trong VBA, k hiểu điều kiện sai ở chỗ nào mà ko ra đc kết quả

Vừa thử xong, chạy ầm ầm luôn. Chỉ có điều là code nhìn ngộ quá.

huuthang_bd · 30/5/17

keke355992 đã viết:
Tiện đây, nhờ a @VetMini xem giúp e bài này. sử dụng hàm sumifs trong VBA, k hiểu điều kiện sai ở chỗ nào mà ko ra đc kết quả

Bạn sửa [H2] thành [H2].Value2 là được

keke355992 · 30/5/17

NguyenNgocThuHien đã viết:
Vừa thử xong, chạy ầm ầm luôn. Chỉ có điều là code nhìn ngộ quá.

Phải thêm value2 mới chạy đc mà bạn. Mới cả Sumifs ngoài cách viết code kiểu đó thì còn cách dùng FormulaR1C1 nữa. Chứ mình có thấy nó ngộ đâu nhỉ

keke355992 · 30/5/17

huuthang_bd đã viết:
Bạn sửa [H2] thành [H2].Value2 là được

Nhớ là có đọc 1 comment nói về Value2, hình như của @ThuNghi thì phải, bảo rằng cứ nhắc đến ngày tháng thì chơi thằng Value2. Mà nay ko nghĩ ra. Cảm ơn a !

The only difference between this property and the Value property is that the Value2 property doesn’t use the Currency and Date data types. You can return values formatted with these data types as floating-point numbers by using the Double data type.

keke355992 · 30/5/17

VetMini đã viết:
Bạn copy code đưa lên, và cho biết code làm cái gì. Tôi đọc lô gic của code trước và chỉ tải file về khi cần kiểm chứng đúng sai.

E đang vọc cách sử dụng hàm Excel trong VBA, sáng nay mắc đoạn hàm Sumifs về cái điều kiện liên quan đến ngày tháng. Value nó k chịu, mà phải là value2

NguyenNgocThuHien · 31/5/17

keke355992 đã viết:
Nhớ là có đọc 1 comment nói về Value2, hình như của @ThuNghi thì phải, bảo rằng cứ nhắc đến ngày tháng thì chơi thằng Value2. Mà nay ko nghĩ ra. Cảm ơn a !

The only difference between this property and the Value property is that the Value2 property doesn’t use the Currency and Date data types. You can return values formatted with these data types as floating-point numbers by using the Double data type.

Thử dùng cái này xem CDbl([H2])

NguyenNgocThuHien · 31/5/17

keke355992 đã viết:
Phải thêm value2 mới chạy đc mà bạn. Mới cả Sumifs ngoài cách viết code kiểu đó thì còn cách dùng FormulaR1C1 nữa. Chứ mình có thấy nó ngộ đâu nhỉ

Mình nói ngộ là do đoạn code sau, dùng khá là lẫn lộn mọi thứ, lúc thì dùng viết tắt, lúc thì dùng dạng đầy đủ. Cái nữa là code của bạn lại chạy được trên máy mình, không rõ có phải do vấn đề định dạng ngày tháng không?

Mã:

With Sheets("A")
[K5].Value = Application.WorksheetFunction.SumIfs(.Range("E4:E15"), _
                                                  .Range("D4:D15"), [H3], _
                                                  .Range("C4:C15"), "<" & CDbl([H2]))
End With

keke355992 · 1/6/17

Chào mọi người. Cho mình hỏi về phương thức Find, với cách tìm kiếm gần chính xác như trong file đính kèm. Xin cảm ơn !

uyento · 2/6/17

Em chào mọi người!
Em mới tập tành VBA. có 1 câu lệnh mà em không biết sửa như thế nào mong người chỉ giáo giúp với ạ!
" Case Is = 5
Rows("42:42,52:52").EntireRow.Hidden = True
Rows("286:287").RowHeight = 148
End Select "

phulien1902 · 2/6/17

uyento đã viết:
Em chào mọi người!
Em mới tập tành VBA. có 1 câu lệnh mà em không biết sửa như thế nào mong người chỉ giáo giúp với ạ!
" Case Is = 5
Rows("42:42,52:52").EntireRow.Hidden = True
Rows("286:287").RowHeight = 148
End Select "

Bạn thử với:

PHP:

Sub abc()
    Application.ScreenUpdating = False
    Select Case Range("A1").Value
    Case 5
        Rows("42:42").EntireRow.Hidden = True
        Rows("52:52").EntireRow.Hidden = True
        Rows("286:287").RowHeight = 148
    End Select
    Application.ScreenUpdating = True
End Sub

uyento · 2/6/17

phulien1902 đã viết:

Bạn thử với:

PHP:

Sub abc()
    Application.ScreenUpdating = False
    Select Case Range("A1").Value
    Case 5
        Rows("42:42").EntireRow.Hidden = True
        Rows("52:52").EntireRow.Hidden = True
        Rows("286:287").RowHeight = 148
    End Select
    Application.ScreenUpdating = True
End Sub

Em cám ơn ạ!

vanthinh3101 · 5/6/17

Nhờ mọi người giúp đỡ tìm ra lỗi của code này với ah.
Tôi có 1 bảng dữ liệu với 1 cột có các giá trị là Ban Giám đốc, Phòng Kế toán - Ngân quỹ, Phòng Khách hàng, Phòng Giám sát Hoạt động.
Tôi đã đưa các giá trị trên vào 1 array.
Khi dùng vòng lặp For...Next thì đến giá trị thứ 2 thì bị lỗi ở hàm CountIf, J ra kết quả là 0
Nhờ mọi người chỉ giáo giúp

Mã:

Sub Macro1()
    Dim Criteria(1 To 5) As String, rng As Variant
    Dim I As Integer, J As Integer, K As Integer
    Dim ws1 As Worksheet, ws2 As Worksheet
   
    Set ws1 = ThisWorkbook.Sheets(1)
    Set ws2 = ThisWorkbook.Sheets(2)
   
    Criteria(1) = "Ban Giám " & ChrW(273) & ChrW(7889) & "c"
    Criteria(2) = "Phòng Giám sát Ho" & ChrW(7841) & "t " & ChrW(273) & ChrW(7897) & "ng"
    Criteria(3) = "Phòng Khách hàng"
    Criteria(4) = "Phòng K" & ChrW(7871) & " toán - Ngân qu" & ChrW(7929)
    Criteria(5) = "Phòng Qu" & ChrW(7843) & "n lý các PGD B" & ChrW(432) & "u " & ChrW(273) & "i" & ChrW(7879) & "n"
   
    With ws2
        For I = 1 To UBound(Criteria)
            J = Application.WorksheetFunction.CountIf(.Range("CF3", .Range("CF3").End(xlDown)), Criteria(I))
            With .Range("A2", .Range("A2").End(xlDown)).Resize(, 87)
                .Parent.AutoFilterMode = False
                .AutoFilter
                .AutoFilter field:=84, Criteria1:=Criteria(I)
                Set rng = .Parent.AutoFilter.Range.Offset(1).Resize(J, 1)
                With ws1
                    K = .Cells.Find(what:=Criteria(I)).Row + 1
                    .Range("A" & K).Resize(J) = rng.Value2
                End With
            End With
        Next I
    End With
 
End Sub

befaint · 5/6/17

vanthinh3101 đã viết:
Nhờ mọi người giúp đỡ tìm ra lỗi của code này với ah.
Tôi có 1 bảng dữ liệu với 1 cột có các giá trị là Ban Giám đốc, Phòng Kế toán - Ngân quỹ, Phòng Khách hàng, Phòng Giám sát Hoạt động.
Tôi đã đưa các giá trị trên vào 1 array.
Khi dùng vòng lặp For...Next thì đến giá trị thứ 2 thì bị lỗi ở hàm CountIf, J ra kết quả là 0
Nhờ mọi người chỉ giáo giúp

- Quy tắc: Gửi thêm file dữ liệu và nêu yêu cầu cụ thể!

vanthinh3101 · 5/6/17

befaint đã viết:
- Quy tắc: Gửi thêm file dữ liệu và nêu yêu cầu cụ thể!

Em muốn lấy dữ liệu từ sheet Data sang sheet Bang luong
Ở sheet Bang lương, cột nào cần lấy số liệu, em đã đánh số thứ tự tương ứng với số cột của sheet Data rồi
Bác lưu ý cho em câu hỏi tìm lỗi ở bài trên nhé!

TTThuyen · 6/6/17

Bác nào giúp e tự động insert với ạ!
Tại sheet 1 khi e insert thêm 1 dòng ( dưới dòng 16) thì sheet 2 sẽ tự động copy dòng 120 và insert xuống

HieuCD · 6/6/17

vanthinh3101 đã viết:
Em muốn lấy dữ liệu từ sheet Data sang sheet Bang luong
Ở sheet Bang lương, cột nào cần lấy số liệu, em đã đánh số thứ tự tương ứng với số cột của sheet Data rồi
Bác lưu ý cho em câu hỏi tìm lỗi ở bài trên nhé!

phải bỏ filter mới đếm được

Mã:

    With ws2
        For I = 1 To UBound(Criteria)
            .Range("A2").Parent.AutoFilterMode = False
            J = Application.WorksheetFunction.CountIf(.Range("CF3", .Range("CF3").End(xlDown)), Criteria(I))
            With .Range("A2", .Range("A2").End(xlDown)).Resize(, 87)
                .AutoFilter field:=84, Criteria1:=Criteria(I)
                Set rng = .Parent.AutoFilter.Range.Offset(1).Resize(J, 1)
                With ws1
                    K = .Cells.Find(what:=Criteria(I)).Row + 1
                    .Range("A" & K).Resize(J) = rng.Value2
                End With
            End With
        Next I
    End With

Ba Tê · 6/6/17

vanthinh3101 đã viết:
Em muốn lấy dữ liệu từ sheet Data sang sheet Bang luong
Ở sheet Bang lương, cột nào cần lấy số liệu, em đã đánh số thứ tự tương ứng với số cột của sheet Data rồi
Bác lưu ý cho em câu hỏi tìm lỗi ở bài trên nhé!

Biểu đọc code của bạn rồi tìm chỗ sai thì thà tôi viết theo ý mình còn "dễ' thở" hơn.
Bạn xem file nhé, có gì thì bàn tiếp.

vanthinh3101 · 6/6/17

HieuCD đã viết:

phải bỏ filter mới đếm được

Mã:

    With ws2
        For I = 1 To UBound(Criteria)
            .Range("A2").Parent.AutoFilterMode = False
            J = Application.WorksheetFunction.CountIf(.Range("CF3", .Range("CF3").End(xlDown)), Criteria(I))
            With .Range("A2", .Range("A2").End(xlDown)).Resize(, 87)
                .AutoFilter field:=84, Criteria1:=Criteria(I)
                Set rng = .Parent.AutoFilter.Range.Offset(1).Resize(J, 1)
                With ws1
                    K = .Cells.Find(what:=Criteria(I)).Row + 1
                    .Range("A" & K).Resize(J) = rng.Value2
                End With
            End With
        Next I
    End With

Bác HieuCD cho em hỏi thêm với ah.
Em muốn đặt rng bằng với kết quả lọc có loại bỏ dòng tiêu đề thì em phải làm sao ah.

vanthinh3101 · 6/6/17

Ba Tê đã viết:
Biểu đọc code của bạn rồi tìm chỗ sai thì thà tôi viết theo ý mình còn "dễ' thở" hơn.
Bạn xem file nhé, có gì thì bàn tiếp.

Em cám ơn bác ah.
Quả thực hàm mảng nhanh nhưng cũng phức tạp quá.

HieuCD · 6/6/17

vanthinh3101 đã viết:
Bác HieuCD cho em hỏi thêm với ah.
Em muốn đặt rng bằng với kết quả lọc có loại bỏ dòng tiêu đề thì em phải làm sao ah.

lệnh
Set rng = .Parent.AutoFilter.Range.Offset(1).Resize(J, 1)
trong đó Offset(1) là xuống 1 dòng để bỏ dòng tiêu đề
bạn thử code

Mã:

    With ws2
        For I = 1 To UBound(Criteria)
            .Range("A2").Parent.AutoFilterMode = False
            With .Range("A2", .Range("A2").End(xlDown)).Resize(, 87)
                .AutoFilter field:=84, Criteria1:=Criteria(I)
            End With
            Set rng = .Range("A3", .Range("A2").End(xlDown)).SpecialCells(xlCellTypeVisible)
            With ws1
                  K = .Cells.Find(what:=Criteria(I)).Row + 1
                  .Range("A" & K).Resize(rng.Rows.Count) = rng.Value2
            End With
        Next I
    End With

ntunga2 · 7/6/17

Xin chào cả nhà
Mình muốn hỏi nếu mình muốn viết code đổi màu ô dữ liệu trong exel thì làm thế nào

phulien1902 · 7/6/17

ntunga2 đã viết:
Xin chào cả nhà
Mình muốn hỏi nếu mình muốn viết code đổi màu ô dữ liệu trong exel thì làm thế nào

Có rất nhiều cách tô màu dữ liệu trong Excel, không rõ bạn muốn tô màu thế nào?

phuyen89 · 7/6/17

ntunga2 đã viết:
Xin chào cả nhà
Mình muốn hỏi nếu mình muốn viết code đổi màu ô dữ liệu trong exel thì làm thế nào

Một cách đổi màu của ô trong Excel/

PHP:

Sub abc()
    Range("A1:A10").Interior.ColorIndex = 8
End Sub

ntunga2 · 8/6/17

phuyen89 đã viết:
Một cách đổi màu của ô trong Excel/

PHP:

Sub abc() Range("A1:A10").Interior.ColorIndex = 8 End Sub

hi.thanks bạn nhiều

guiga 92 · 9/6/17

Chào anh chị!
Mình mới gia nhập GPE. Hiện mình muốn học về lập trình(về VBA, macro, access) các bạn có tài liệu nào chia sẻ cho mình với nhé!
Tks!

phulien1902 · 9/6/17

guiga 92 đã viết:
Chào anh chị!
Mình mới gia nhập GPE. Hiện mình muốn học về lập trình(về VBA, macro, access) các bạn có tài liệu nào chia sẻ cho mình với nhé!
Tks!

Diễn đàn GPE có cả 1 kho tài liệu khổng lồ, chưa đủ để bạn học tập & nghiên cứu à?

guiga 92 · 9/6/17

phulien1902 đã viết:
Diễn đàn GPE có cả 1 kho tài liệu khổng lồ, chưa đủ để bạn học tập & nghiên cứu à?

Mình học từ đầu bạn có tài liệu share cho mình nhé

thanhpd3 · 14/6/17

Kính gửi anh chị đồng môn yêu thích VBA trong Excel

Mình có một vấn đề nhờ anh chị giúp đở.

Số là mình có làm 1 form nhập liệu bằng với VBA. Khi mình lấy giá trị từ 1 label. Giá trị mình lấy nó ở dạng text. Mình muốn lấy giá trị từ label nhưng ở dạng số number.

Mong các bạn cho xin cao kiến.

giaiphap · 14/6/17

thanhpd3 đã viết:
Kính gửi anh chị đồng môn yêu thích VBA trong Excel

Mình có một vấn đề nhờ anh chị giúp đở.

Số là mình có làm 1 form nhập liệu bằng với VBA. Khi mình lấy giá trị từ 1 label. Giá trị mình lấy nó ở dạng text. Mình muốn lấy giá trị từ label nhưng ở dạng số number.

Mong các bạn cho xin cao kiến.

Dùng lệnh này thử xem.

Mã:

Val(Label1.Caption)

Hoang2013 · 14/6/17

Số là mình có làm 1 form nhập liệu bằng với VBA. Khi mình lấy giá trị từ 1 label. Giá trị mình lấy nó ở dạng text. Mình muốn lấy giá trị từ label nhưng ở dạng số number.
Mong các bạn cho xin cao kiến.

Kiến lữa của mình là: Sao bạn lại lấy từ Label, mà không là TextBox hay ComboBox?

giaiphap · 14/6/17

Hoang2013 đã viết:
Kiến lữa của mình là: Sao bạn lại lấy từ Label, mà không là TextBox hay ComboBox?

Có khi là sở thích đó bạn.

Thong Hoang Tien 250691 · 14/6/17

thanhpd3 đã viết:
Kính gửi anh chị đồng môn yêu thích VBA trong Excel

Mình có một vấn đề nhờ anh chị giúp đở.

Số là mình có làm 1 form nhập liệu bằng với VBA. Khi mình lấy giá trị từ 1 label. Giá trị mình lấy nó ở dạng text. Mình muốn lấy giá trị từ label nhưng ở dạng số number.

Mong các bạn cho xin cao kiến.

.value nhé bạn, format của cells bạn muốn nhập data vào phải ở dạng number.

phuyen89 · 14/6/17

thanhpd3 đã viết:
Kính gửi anh chị đồng môn yêu thích VBA trong Excel

Mình có một vấn đề nhờ anh chị giúp đở.

Số là mình có làm 1 form nhập liệu bằng với VBA. Khi mình lấy giá trị từ 1 label. Giá trị mình lấy nó ở dạng text. Mình muốn lấy giá trị từ label nhưng ở dạng số number.

Mong các bạn cho xin cao kiến.

Bạn thử dùng hàm Val để convert từ Số được lưu dưới dạng text sang Number chưa?

VetMini · 14/6/17

Hàm Val có tính rất dễ dãi. Tự bẫy lỗi và tự bỏ đi những chỗ không dịch được.
Vì vậy dùng hàm này nên cẩn thận.

Nếu biết loại số của mình thì dùng hàm CInt, CLng, CDbl và code bẫy lỗi sẽ an toàn hơn.

ndhmoney686 · 18/6/17

Em chào A/C!
Em đang tạo code để Clear filter một loạt các sheets trong file, đang ở chế độ filter. Hiện tại nếu các sheet đều filter thì code chạy được. Nhưng nếu sheet nào đó ko filter thì code bị lỗi và dừng lại. A/C sửa hoặc bổ sung giúp Em cách bẫy lỗi trường hợp ko Filter thì next sang các sheet tiếp theo. Cảm ơn A/C nhiều!

Mã:

Sub ClearAllSheet()
On Error Resume Next
Sheet16.Select ActiveSheet.ShowAllData
Sheet2.Select ActiveSheet.ShowAllData
Sheet4.Select ActiveSheet.ShowAllData
Sheet5.Select ActiveSheet.ShowAllData
Sheet6.Select ActiveSheet.ShowAllData
Sheet9.Select ActiveSheet.ShowAllData
Sheet13.Select ActiveSheet.ShowAllData
Sheet14.Select ActiveSheet.ShowAllData
Sheet15.Select ActiveSheet.ShowAllData
Sheet16.Select ActiveSheet.ShowAllData
Sheet17.Select ActiveSheet.ShowAllData
Sheet19.Select ActiveSheet.ShowAllData
Sheet21.Select ActiveSheet.ShowAllData
Sheet22.Select ActiveSheet.ShowAllData
End Sub

phuyen89 · 18/6/17

ndhmoney686 đã viết:
Em chào A/C!
Em đang tạo code để Clear filter một loạt các sheets trong file, đang ở chế độ filter. Hiện tại nếu các sheet đều filter thì code chạy được. Nhưng nếu sheet nào đó ko filter thì code bị lỗi và dừng lại. A/C sửa hoặc bổ sung giúp Em cách bẫy lỗi trường hợp ko Filter thì next sang các sheet tiếp theo. Cảm ơn A/C nhiều!

Mã:

Sub ClearAllSheet() On Error Resume Next Sheet16.Select ActiveSheet.ShowAllData Sheet2.Select ActiveSheet.ShowAllData Sheet4.Select ActiveSheet.ShowAllData Sheet5.Select ActiveSheet.ShowAllData Sheet6.Select ActiveSheet.ShowAllData Sheet9.Select ActiveSheet.ShowAllData Sheet13.Select ActiveSheet.ShowAllData Sheet14.Select ActiveSheet.ShowAllData Sheet15.Select ActiveSheet.ShowAllData Sheet16.Select ActiveSheet.ShowAllData Sheet17.Select ActiveSheet.ShowAllData Sheet19.Select ActiveSheet.ShowAllData Sheet21.Select ActiveSheet.ShowAllData Sheet22.Select ActiveSheet.ShowAllData End Sub

- Nên nghĩ bạn nên dùng vòng lặp For để chạy qua các Sheet.
- Kiểm tra tình trạng bảng tính Có Filter hay không?
- Nếu có thì tiến hành ShowAllData như bạn muốn, còn không thì bỏ qua.

ndhmoney686 · 18/6/17

phuyen89 đã viết:
- Nên nghĩ bạn nên dùng vòng lặp For để chạy qua các Sheet.
- Kiểm tra tình trạng bảng tính Có Filter hay không?
- Nếu có thì tiến hành ShowAllData như bạn muốn, còn không thì bỏ qua.

Bạn viết giúp mình code dùng vòng lặp for đó được ko Bạn? Tks Bạn!

phuyen89 · 18/6/17

ndhmoney686 đã viết:
Bạn viết giúp mình code dùng vòng lặp for đó được ko Bạn? Tks Bạn!

PHP:

Sub ShowAll_Data()
    On Error Resume Next
    Dim AuF As AutoFilter
    Dim Wks As Worksheet
    For Each Wks In Worksheets
        Wks.Select
        Set AuF = Wks.AutoFilter
        If AuF.FilterMode = True Then
            Wks.ShowAllData
        End If
    Next Wks
End Sub

- Bạn chép vào Module-->Ra ngoài bảng tính-->alt+F8-->Run xem thế nào.

HieuCD · 18/6/17

ndhmoney686 đã viết:
Em chào A/C!
Em đang tạo code để Clear filter một loạt các sheets trong file, đang ở chế độ filter. Hiện tại nếu các sheet đều filter thì code chạy được. Nhưng nếu sheet nào đó ko filter thì code bị lỗi và dừng lại. A/C sửa hoặc bổ sung giúp Em cách bẫy lỗi trường hợp ko Filter thì next sang các sheet tiếp theo. Cảm ơn A/C nhiều!

Mã:

Sub ClearAllSheet() On Error Resume Next Sheet16.Select ActiveSheet.ShowAllData Sheet2.Select ActiveSheet.ShowAllData Sheet4.Select ActiveSheet.ShowAllData Sheet5.Select ActiveSheet.ShowAllData Sheet6.Select ActiveSheet.ShowAllData Sheet9.Select ActiveSheet.ShowAllData Sheet13.Select ActiveSheet.ShowAllData Sheet14.Select ActiveSheet.ShowAllData Sheet15.Select ActiveSheet.ShowAllData Sheet16.Select ActiveSheet.ShowAllData Sheet17.Select ActiveSheet.ShowAllData Sheet19.Select ActiveSheet.ShowAllData Sheet21.Select ActiveSheet.ShowAllData Sheet22.Select ActiveSheet.ShowAllData End Sub

thử code

Mã:

Sub ClearAllSheet()
On Error Resume Next
For i = 1 To Sheets.Count
  Sheets(i).ShowAllData
Next i
End Sub

ndhmoney686 · 18/6/17

phuyen89 đã viết:
PHP:

Sub ShowAll_Data() On Error Resume Next Dim AuF As AutoFilter Dim Wks As Worksheet For Each Wks In Worksheets Wks.Select Set AuF = Wks.AutoFilter If AuF.FilterMode = True Then Wks.ShowAllData End If Next Wks End Sub

- Bạn chép vào Module-->Ra ngoài bảng tính-->alt+F8-->Run xem thế nào.

HieuCD đã viết:
thử code

Mã:

Sub ClearAllSheet() On Error Resume Next For i = 1 To Sheets.Count Sheets(i).ShowAllData Next i End Sub

Em chạy code rồi, Rất tuyệt.
Cảm ơn Bạn phuyen89 và Anh HieuCD rất nhiều!

tueyennhi · 24/6/17

Public Sub Hoi_sinh()
Sheets("Form").Copy After:=Sheets("Form")
End Sub

Code này em dùng để copy sheet Form, tuy nhiên vì sheet này của em đang ẩn nên khi chạy lệnh này cũng tạo ra Sheet ẩn. Vậy làm thế nào để sheet mới được tạo ra sẽ hiện?

phulien1902 · 24/6/17

tueyennhi đã viết:
Public Sub Hoi_sinh()
Sheets("Form").Copy After:=Sheets("Form")
End Sub

Code này em dùng để copy sheet Form, tuy nhiên vì sheet này của em đang ẩn nên khi chạy lệnh này cũng tạo ra Sheet ẩn. Vậy làm thế nào để sheet mới được tạo ra sẽ hiện?

Bạn thử:

PHP:

Public Sub Hoi_sinh()
     Sheets("Form").Visible = True
  Sheets("Form").Copy After:=Sheets("Form")
    Sheets("Form").Visible = False
End Sub

befaint · 24/6/17

tueyennhi đã viết:
Public Sub Hoi_sinh()
Sheets("Form").Copy After:=Sheets("Form")
End Sub

Code này em dùng để copy sheet Form, tuy nhiên vì sheet này của em đang ẩn nên khi chạy lệnh này cũng tạo ra Sheet ẩn. Vậy làm thế nào để sheet mới được tạo ra sẽ hiện?

PHP:

Public Sub Hoi_sinh()
Sheets("Form").Copy After:=Sheets("Form")
Sheets(Sheets("Form").Index + 1).Visible = True
End Sub

tueyennhi · 24/6/17

befaint đã viết:
PHP:

Public Sub Hoi_sinh() Sheets("Form").Copy After:=Sheets("Form") Sheets(Sheets("Form").Index + 1).Visible = True End Sub

Cảm ơn Befaint!

sinhvientt · 24/6/17

E có 1 vấn đề này mong các bác giúp:
E có 1 File Access xuất ra từ phần mềm Etabs có đuôi “*.mdb” và 1 File Excel. E muốn nhập dữ liệu từ File “*.mdb” vào các Sheets của File Excel. E dùng chức năng Recorder macro để mò Code thì e được 1 đoạn Code miêu tả quá trình nhập dữ liệu từ File “*.mdb” vào 1 Sheet của File Excel trên.
Nhưng vấn để nảy sinh là: Cái “Data Source” nó lại là cố định ứng với vị trí e để File “*.mdb” đó. Bác nào viết giúp e đoạn Code để e gán vào 1 Nút sao cho khi e Click vào nút đó thì nó hiện ra 1 cửa sổ để e chọn đến vị trí của File “*.mdb” bất kỳ với! Như vậy thì sẽ linh động hơn nhiều là để File “*.mdb” tại 1 vị trí cố định.

Đoạn Code mà máy Recoder được:

Mã:

Sheets("Frame Section Properties").Select
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=C:\ThepCot.mdb;Mode" _
, _
"=Share Deny Write;ExtendedProperties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";" _
, _
"Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions" _
, _
"=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Co" _
, _
"py Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
), Destination:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("Frame Section Properties")
.Name = "ThepCot"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = "C:\ThepCot.mdb"
.Refresh BackgroundQuery:=False
End With

Em xin chân thành cảm ơn!

phuyen89 · 24/6/17

sinhvientt đã viết:
E có 1 vấn đề này mong các bác giúp:
E có 1 File Access xuất ra từ phần mềm Etabs có đuôi “*.mdb” và 1 File Excel. E muốn nhập dữ liệu từ File “*.mdb” vào các Sheets của File Excel. E dùng chức năng Recorder macro để mò Code thì e được 1 đoạn Code miêu tả quá trình nhập dữ liệu từ File “*.mdb” vào 1 Sheet của File Excel trên.
Nhưng vấn để nảy sinh là: Cái “Data Source” nó lại là cố định ứng với vị trí e để File “*.mdb” đó. Bác nào viết giúp e đoạn Code để e gán vào 1 Nút sao cho khi e Click vào nút đó thì nó hiện ra 1 cửa sổ để e chọn đến vị trí của File “*.mdb” bất kỳ với! Như vậy thì sẽ linh động hơn nhiều là để File “*.mdb” tại 1 vị trí cố định.

Đoạn Code mà máy Recoder được:

Mã:

Sheets("Frame Section Properties").Select Range("A1").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=C:\ThepCot.mdb;Mode" _ , _ "=Share Deny Write;ExtendedProperties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";" _ , _ "Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions" _ , _ "=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Co" _ , _ "py Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=Range("A1")) .CommandType = xlCmdTable .CommandText = Array("Frame Section Properties") .Name = "ThepCot" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "C:\ThepCot.mdb" .Refresh BackgroundQuery:=False End With

Em xin chân thành cảm ơn!

Bạn có thể làm như thế này.
+ Đầu tiền bạn khai báo 1 biến chuỗi, mục đích là để lưu đường dẫn.
+ Sau đó bạn gán giá trị của 01 cell nào đó trên bảng tính vào biến này, như vậy là bạn có thể thay đổi tùy ý rồi.

Mã:

Sub abc()
Dim strPath As String
strPath = Range("A1").Value
Sheets("Frame Section Properties").Select
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:=Array( _
    "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=strPath;Mode" _
    , _
    "=Share Deny Write;ExtendedProperties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";" _
    , _
    "Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions" _
    , _
    "=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Co" _
    , _
    "py Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
    ), Destination:=Range("A1"))
    .CommandType = xlCmdTable
    .CommandText = Array("Frame Section Properties")
    .Name = "ThepCot"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    .SourceDataFile = strPath
    .Refresh BackgroundQuery:=False
    End With
End Sub

Trên Cell A1 của bảng tính bạn đưa đường dẫn này vào xem sao:

Mã:

C:\ThepCot.mdb

sinhvientt · 25/6/17

phuyen89 đã viết:
Bạn có thể làm như thế này.
+ Đầu tiền bạn khai báo 1 biến chuỗi, mục đích là để lưu đường dẫn.
+ Sau đó bạn gán giá trị của 01 cell nào đó trên bảng tính vào biến này, như vậy là bạn có thể thay đổi tùy ý rồi.

Mình cũng vừa chạy thử nhưng Code bị báo lỗi bạn à, nhưng khi click vào nút thì ko thấy nó hiện ra cái cửa sổ để mình tự chọn đường dẫn đến file như mình đang mong muốn. Ý mình là muốn tạo ra 1 cái nút kiểu như "Nhập Dữ Liệu", khi click vào nút này thì sẽ hiện ra 1 cửa sổ để mình tự chọn đường dẫn bất kỳ đến File cần. Đường dẫn là ko cố định bạn à! File "*mdb" là file chứa dữ liệu mà mình cần import vào file Excel, và file"*mbd" đó mình muốn là nó có thể để bất kỳ ở vị trí nào trong ổ cứng, chứ nó ko để cố định ở 1 đường dẫn cụ thể nào cả. Khi mình dùng chức năng Recorder để mò Code thì mình dùng chức năng "Import External data" rồi đi đến vị trí để file "*mdb", do vậy Code ứng với Data Source là cố định với vị trí để File *mdb đó, nên thật cứng nhắc và bất tiện. Bạn xem còn cách nào ko giúp mình với, mình dốt về khoản VBA này nên mới đang tìm hiểu bước đầu coi như là ko biết gì cả!
Cảm ơn bạn nhiều!

phuyen89 · 25/6/17

sinhvientt đã viết:
Mình cũng vừa chạy thử nhưng Code bị báo lỗi bạn à, nhưng khi click vào nút thì ko thấy nó hiện ra cái cửa sổ để mình tự chọn đường dẫn đến file như mình đang mong muốn. Ý mình là muốn tạo ra 1 cái nút kiểu như "Nhập Dữ Liệu", khi click vào nút này thì sẽ hiện ra 1 cửa sổ để mình tự chọn đường dẫn bất kỳ đến File cần. Đường dẫn là ko cố định bạn à! File "*mdb" là file chứa dữ liệu mà mình cần import vào file Excel, và file"*mbd" đó mình muốn là nó có thể để bất kỳ ở vị trí nào trong ổ cứng, chứ nó ko để cố định ở 1 đường dẫn cụ thể nào cả. Khi mình dùng chức năng Recorder để mò Code thì mình dùng chức năng "Import External data" rồi đi đến vị trí để file "*mdb", do vậy Code ứng với Data Source là cố định với vị trí để File *mdb đó, nên thật cứng nhắc và bất tiện. Bạn xem còn cách nào ko giúp mình với, mình dốt về khoản VBA này nên mới đang tìm hiểu bước đầu coi như là ko biết gì cả!
Cảm ơn bạn nhiều!

Vậy bạn cần tìm hiểu phương thức sau:

Application.GetOpenFilename

để bạn có thể chọn File tùy ý.

al0nebaby · 29/6/17

Chào mọi người, E có 1 code của 1 tiền bối ở trong diễn đàn, ngày trước có down về xem, bỏ 1 thời gian nên quên mất bài ở đâu để hỏi tiền bối ấy. Hiện tại thì e rất cần để áp dụng vào bảng của mình nên cần hiểu rõ hết code( e là newbie). Mọi người có thể giải thích cho e code này được không ạ. Chi tiết từng dòng thì thật là tốt ạ. Cảm ơn mọi người rất nhiều!

Public Sub GPE()
Dim sArr(), dArr(), Rws As Object, Col As Object, I As Long, J As Long, K As Long
Dim Rw As Long, C As Long, iRw As Long, jCol As Long
Set Rws = CreateObject("Scripting.Dictionary")
Set Col = CreateObject("Scripting.Dictionary")
With Sheets("KQ")
sArr = .Range(.[D2], .[D2].End(xlToRight)).Value
C = UBound(sArr, 2)
For J = 1 To UBound(sArr, 2)
Col.Add sArr(1, J), J
Next J
sArr = .Range(.[B3], .[B3].End(xlDown)).Value
Rw = UBound(sArr, 1)
For I = 1 To UBound(sArr, 1)
Rws.Add sArr(I, 1), I
Next I
End With
ReDim dArr(1 To Rw, 1 To C)
With Sheets("NGUON")
sArr = .Range(.[C3], .[F65536].End(xlUp)).Value
End With
For I = 1 To UBound(sArr, 1)
If Rws.Exists(sArr(I, 1)) Then
If Col.Exists(sArr(I, 4)) Then
iRw = Rws.Item(sArr(I, 1))
jCol = Col.Item(sArr(I, 4))
dArr(iRw, jCol) = dArr(iRw, jCol) + sArr(I, 3)
End If
End If
Next I
Sheets("KQ").[D3].Resize(Rw, C) = dArr
Set Rws = Nothing
Set Col = Nothing
End Sub

phuyen89 · 29/6/17

al0nebaby đã viết:
Chào mọi người, E có 1 code của 1 tiền bối ở trong diễn đàn, ngày trước có down về xem, bỏ 1 thời gian nên quên mất bài ở đâu để hỏi tiền bối ấy. Hiện tại thì e rất cần để áp dụng vào bảng của mình nên cần hiểu rõ hết code( e là newbie). Mọi người có thể giải thích cho e code này được không ạ. Chi tiết từng dòng thì thật là tốt ạ. Cảm ơn mọi người rất nhiều!

Public Sub GPE()
Dim sArr(), dArr(), Rws As Object, Col As Object, I As Long, J As Long, K As Long
Dim Rw As Long, C As Long, iRw As Long, jCol As Long
Set Rws = CreateObject("Scripting.Dictionary")
Set Col = CreateObject("Scripting.Dictionary")
With Sheets("KQ")
sArr = .Range(.[D2], .[D2].End(xlToRight)).Value
C = UBound(sArr, 2)
For J = 1 To UBound(sArr, 2)
Col.Add sArr(1, J), J
Next J
sArr = .Range(.[B3], .[B3].End(xlDown)).Value
Rw = UBound(sArr, 1)
For I = 1 To UBound(sArr, 1)
Rws.Add sArr(I, 1), I
Next I
End With
ReDim dArr(1 To Rw, 1 To C)
With Sheets("NGUON")
sArr = .Range(.[C3], .[F65536].End(xlUp)).Value
End With
For I = 1 To UBound(sArr, 1)
If Rws.Exists(sArr(I, 1)) Then
If Col.Exists(sArr(I, 4)) Then
iRw = Rws.Item(sArr(I, 1))
jCol = Col.Item(sArr(I, 4))
dArr(iRw, jCol) = dArr(iRw, jCol) + sArr(I, 3)
End If
End If
Next I
Sheets("KQ").[D3].Resize(Rw, C) = dArr
Set Rws = Nothing
Set Col = Nothing
End Sub

- Trong này có những dòng đơn giản, bạn ghi ra đi, không biết chỗ nào mọi người bổ sung thêm, chứ làm từ A--Z hơi ngán. Một phần nữa sẽ giúp cho bạn tư duy thêm.

al0nebaby · 29/6/17

phuyen89 đã viết:
- Trong này có những dòng đơn giản, bạn ghi ra đi, không biết chỗ nào mọi người bổ sung thêm, chứ làm từ A--Z hơi ngán. Một phần nữa sẽ giúp cho bạn tư duy thêm.

Cảm ơn bác phuyen89 đã góp ý ạ.
Thực ra thì e mới bâp bẹ tự hoc VBA được chừng 2 tuần, vì phần lớn là tự tra cứu trên các diễn đàn và suy diễn nên cho dù nắm được chút kiến thức nhưng vô vàn cái vẫn không biết và lơ ngơ. Code này thì e đã tự suy diễn rất nhiều với vốn kiến thức ít ỏi của mình cũng đã mường tượng được phần nào nhưng vẫn k nắm rõ được vì thiếu quá nhiều kiến thức e không biết. Nên mạn phép xin được bác giải thích chi tiết để củng cố kiến thức của mình ạ. Nếu không được thì có thể giải thích qua qua cũng được ạ. Mong không mất quá nhiều thời gian của bác và mọi người ạ. E cảm ơn!

thienmaifx · 1/7/17

Code VBA
Tôi mới học VBA mong được giải thích? Tôi có 2 code sub bang1 và sub bang2 (file kèm theo), 2 sub trên theo tôi là như nhau, với sub bang1 thì báo lỗi khi tăng số dòng, với sub bang2 thì báo lỗi - có thể chỉnh dùm cách khai báo biến. giải thích tại sao?

phuyen89 · 1/7/17

thienmaifx đã viết:
Code VBA
Tôi mới học VBA mong được giải thích? Tôi có 2 code sub bang1 và sub bang2 (file kèm theo), 2 sub trên theo tôi là như nhau, với sub bang1 thì báo lỗi khi tăng số dòng, với sub bang2 thì báo lỗi - có thể chỉnh dùm cách khai báo biến. giải thích tại sao?

PHP:

Sub bang1()
  Dim Darr(), Arr()
  Dim i As Long, j As Long, k As Long
With Sheets("1")
  Darr = Range("A1:F10000").Value
  ReDim Arr(1 To UBound(Darr), 1 To 6)
  For i = 1 To UBound(Darr)
    If Darr(i, 1) > 0 Then
      k = k + 1
      For j = 1 To 6
        Arr(k, j) = Darr(i, j)
      Next j
    End If
  Next i
Range("G1").Resize(k, 6).Value = Arr
End With
End Sub

+ Vì Darr(i,1) nó là cột, không có giá trị, vì thế biến k không bao giờ tăng lên, nó mãi mãi là số 0. Điều đó tạo nên dòng này không thể thực hiện được.

PHP:

Range("G1").Resize(k, 6).Value = Arr

-->Gây nên lỗi.

thienmaifx · 1/7/17

sub bang1 vẫn chạy được mà Đại ca, k vẫn tăng theo i nhưng khi tăng dòng thì bị lỗi thôi . không hiểu vì sao- nếu viết lại code xin chỉ giáo

ndu96081631 · 1/7/17

thienmaifx đã viết:
sub bang1 vẫn chạy được mà Đại ca, k vẫn tăng theo i nhưng khi tăng dòng thì bị lỗi thôi . không hiểu vì sao- nếu viết lại code xin chỉ giáo

Bạn bấm nút XÓA trước thì cả 2 sub đều.. tèo

keke355992 · 2/7/17

Các bạn cho mình hỏi chút là mình có nhớ đọc được bài của a Hoàng Trọng Nghĩa (Không biết có phải không ạ). Khi mình sang sheet khác, thì dùng code để quay lại sheet ngay trước đó. Nay tìm mãi mà chưa thấy, nhờ các bạn tìm giúp mình. Xin cảm ơn !

thienmaifx · 2/7/17

ndu96081631 đã viết:
Bạn bấm nút XÓA trước thì cả 2 sub đều.. tèo

Vậy phải viết lại sao cho đúng xin chỉ giáo

ndu96081631 · 2/7/17

thienmaifx đã viết:
Vậy phải viết lại sao cho đúng xin chỉ giáo

Tôi viết vầy:

Mã:

Sub bang1()
  On Error Resume Next
  With Sheets("1")
    .Range("A1:F1000").SpecialCells(xlCellTypeConstants).Copy .Range("G1")
  End With
End Sub
Sub bang2()
  On Error Resume Next
  With Sheets("1")
    .Range("N1:S1000").SpecialCells(xlCellTypeConstants).Copy .Range("T1")
  End With
End Sub

thienmaifx · 2/7/17

ndu96081631 đã viết:

Tôi viết vầy:

Mã:

Sub bang1()
  On Error Resume Next
  With Sheets("1")
    .Range("A1:F1000").SpecialCells(xlCellTypeConstants).Copy .Range("G1")
  End With
End Sub
Sub bang2()
  On Error Resume Next
  With Sheets("1")
    .Range("N1:S1000").SpecialCells(xlCellTypeConstants).Copy .Range("T1")
  End With
End Sub

Hay quá cám ơn Đại ca đúng ý rồi, nhưng khi dòng lớn ("A1:F300000") máy đọc rất chậm, có cánh nào khắc phục không?

Mutants Men · 6/7/17

chào mọi người!
mình có ghi macro lại để chỉnh khi in thì sẽ in luôn chú thích

Mã:

Sub Macro1()
    Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintComments = xlPrintInPlace
    End With
    Application.PrintCommunication = True
 End Sub

nhưng khi chạy xong thì vào xem trong fagesetup ở cả 3 sheet thì không đúng như chạy code
và khi thay lệnh
.PrintComments = xlPrintNoComments' để không in chú thích thì cũng không có tác dụng

phuyen89 · 7/7/17

Mutants Men đã viết:
chào mọi người!
mình có ghi macro lại để chỉnh khi in thì sẽ in luôn chú thích

Mã:

Sub Macro1() Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select Application.PrintCommunication = False With ActiveSheet.PageSetup .PrintComments = xlPrintInPlace End With Application.PrintCommunication = True End Sub

nhưng khi chạy xong thì vào xem trong fagesetup ở cả 3 sheet thì không đúng như chạy code
và khi thay lệnh
.PrintComments = xlPrintNoComments' để không in chú thích thì cũng không có tác dụng

PHP:

Sub PrintComment()
    Application.DisplayCommentIndicator = xlCommentAndIndicator
    Dim Prt As PageSetup
    Set Prt = ActiveSheet.PageSetup
    With Prt
        .PrintComments = xlPrintInPlace
    End With
    ActiveSheet.PrintPreview
End Sub

Mình sửa lại đoạn code của bạn chút.

- PrintComments properties nó có 2 giá trị là:
xlPrintInPlace
xlPrintSheetEnd

Bạn lựa chọn cái nào phù hợp nhé.

huonglien1901 · 7/7/17

phuyen89 đã viết:
PHP:

Sub PrintComment() Application.DisplayCommentIndicator = xlCommentAndIndicator Dim Prt As PageSetup Set Prt = ActiveSheet.PageSetup With Prt .PrintComments = xlPrintInPlace End With ActiveSheet.PrintPreview End Sub

Mình sửa lại đoạn code của bạn chút.

- PrintComments properties nó có 2 giá trị là:
xlPrintInPlace
xlPrintSheetEnd

Bạn lựa chọn cái nào phù hợp nhé.

Code này in chú thích phải không Anh?

Mutants Men · 7/7/17

phuyen89 đã viết:
PHP:

Sub PrintComment() Application.DisplayCommentIndicator = xlCommentAndIndicator Dim Prt As PageSetup Set Prt = ActiveSheet.PageSetup With Prt .PrintComments = xlPrintInPlace End With ActiveSheet.PrintPreview End Sub

Mình sửa lại đoạn code của bạn chút.

- PrintComments properties nó có 2 giá trị là:
xlPrintInPlace
xlPrintSheetEnd

Bạn lựa chọn cái nào phù hợp nhé.

vậy làm sao để chỉnh 1 lúc nhiều sheet được anh. (không dùng vòng lặp chạy qua từng sheet)

Mutants Men · 7/7/17

huonglien1901 đã viết:
Code này in chú thích phải không Anh?

đúng rồi bạn! dùng để in chú thích.

phuyen89 · 7/7/17

Mutants Men đã viết:
đúng rồi bạn! dùng để in chú thích.

+ Nếu không dùng Vòng lặp thì sửa lại chỗ lệnh Print Preview một chút như thế này.

PHP:

Sub PrintComment()
    Application.DisplayCommentIndicator = xlCommentAndIndicator
    Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
    Dim Prt As PageSetup
    Set Prt = ActiveSheet.PageSetup
    With Prt
        .PrintComments = xlPrintInPlace
    End With
    ThisWorkbook.PrintPreview
End Sub

Mutants Men · 7/7/17

phuyen89 đã viết:
+ Nếu không dùng Vòng lặp thì sửa lại chỗ lệnh Print Preview một chút như thế này.

PHP:

Sub PrintComment() Application.DisplayCommentIndicator = xlCommentAndIndicator Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select Dim Prt As PageSetup Set Prt = ActiveSheet.PageSetup With Prt .PrintComments = xlPrintInPlace End With ThisWorkbook.PrintPreview End Sub

ý mình không phải muốn xem trước mà muốn chỉnh toàn bộ sheet có tên trong danh sách sang chế độ in như hiển thị trên trang tính (in chú thích)
trong khi code chỉ thực hiện ngay trên sheet được Active tức là sau khi chạy code thì chỉ có Sheet1 là in được chú thích, còn sheet2 và sheet3 vẫn không in được chú thích

phuyen89 · 7/7/17

Mutants Men đã viết:
ý mình không phải muốn xem trước mà muốn chỉnh toàn bộ sheet có tên trong danh sách sang chế độ in như hiển thị trên trang tính (in chú thích)
trong khi code chỉ thực hiện ngay trên sheet được Active tức là sau khi chạy code thì chỉ có Sheet1 là in được chú thích, còn sheet2 và sheet3 vẫn không in được chú thích

- Ngoài vòng lặp ra, mình chưa nghĩ ra được cách nào hay hơn.

Fridge090 · 7/7/17

bác nào giải thích đoạn code này giúp mình với

ActiveSheet.ListObjects("bang").Range.AutoFilter Field:=1, _
Criteria1:="*" & [b3] & "*", Operator:=xlFilterValues

phuyen89 · 7/7/17

Fridge090 đã viết:
bác nào giải thích đoạn code này giúp mình với

ActiveSheet.ListObjects("bang").Range.AutoFilter Field:=1, _
Criteria1:="*" & [b3] & "*", Operator:=xlFilterValues

- Bạn có 01 cái Table, có tên là bang
- Tiến hành Filter dữ liệu của Table đó, tại cột 1 của bang, dựa vào điều kiện của cells B3.

Fridge090 · 7/7/17

phuyen89 đã viết:
- Bạn có 01 cái Table, có tên là bang
- Tiến hành Filter dữ liệu của Table đó, tại cột 1 của bang, dựa vào điều kiện của cells B3.

Cám ơn bác.
Bác cho em hỏi là giờ em muốn filter cột 2 của bảng thì cần sửa điều kiện gì vậy bác??

phuyen89 · 7/7/17

Fridge090 đã viết:
Cám ơn bác.
Bác cho em hỏi là giờ em muốn filter cột 2 của bảng thì cần sửa điều kiện gì vậy bác??

Mã:

ActiveSheet.ListObjects("bang").Range.AutoFilter Field:=1, _
Criteria1:="*" & [b3] & "*", Operator:=xlFilterValues

Sửa số 1 thành số 2

Fridge090 · 7/7/17

phuyen89 đã viết:
Mã:

ActiveSheet.ListObjects("bang").Range.AutoFilter Field:=1, _ Criteria1:="*" & [b3] & "*", Operator:=xlFilterValues

Sửa số 1 thành số 2

hi bác . theo hướng dẫn của bác em đã lọc đượnc dữ liệu trong bảng
còn vấn đề là nếu dữ liệu định dạng kiểu ngày tháng thì không lọc được.

bác xem giúp em xem bị lỗi gì vậy bác

Fridge090 · 10/7/17

Fridge090 đã viết:
hi bác . theo hướng dẫn của bác em đã lọc đượnc dữ liệu trong bảng
còn vấn đề là nếu dữ liệu định dạng kiểu ngày tháng thì không lọc được.

bác xem giúp em xem bị lỗi gì vậy bác

Nhờ bác nào rảnh vào xem giúp em với

mhieuit · 11/7/17

Chào ACE GPE,
em có đoạn code bên dưới, khi run thì không tác dụng, ACE kiểm tra giúp em nhé. em cảm ơn

Mã:

Sub Copy()
Sheets("Pickticket").Select
    If Sheets("Pickticket").Range("A2") <> Null Then
        Sheets("Pickticket").Range("B2").Copy Sheets("DN").Range("D5").PasteSpecial xlPasteValues
    End If
End Sub

NguyenNgocThuHien · 11/7/17

mhieuit đã viết:
If Sheets("Pickticket").Range("A2") <> Null Then

Anh gửi file lên đi, như vậy mới dễ

phuyen89 · 11/7/17

mhieuit đã viết:
Chào ACE GPE,
em có đoạn code bên dưới, khi run thì không tác dụng, ACE kiểm tra giúp em nhé. em cảm ơn

Sub Copy()
Sheets("Pickticket").Select
If Sheets("Pickticket").Range("A2") <> Null Then
Sheets("Pickticket").Range("B2").Copy Sheets("DN").Range("D5").PasteSpecial xlPasteValues
End If
End Sub

PHP:

Sheets("Pickticket").Range("B2").Copy Sheets("DN").Range("D5").PasteSpecial xlPasteValues

- Dòng này gây ra lỗi của bạn, do bạn dùng phương thức Copy của Range Object không đúng.
- Mặc dù Value là thuộc tính mặc định của đối tượng Range, nhưng bạn không nên bỏ qua như vậy.
Mình sẽ sửa lại như sau: À, phải xem bản tính của bạn Null nó là gì, mà bạn lại đưa vào điều kiện.

PHP:

Sub Copy()
    Sheets("Pickticket").Select
    If Range("A2").Value <> Empty Then
        Sheets("Pickticket").Range("B2").Copy Sheets("DN").Range("D5")
    End If
End Sub

befaint · 11/7/17

mhieuit đã viết:
Chào ACE GPE,
em có đoạn code bên dưới, khi run thì không tác dụng, ACE kiểm tra giúp em nhé. em cảm ơn

Mã:

Sub Copy() .. End Sub

PHP:

Sub Copy()
With Sheets("Pickticket")
    If .Range("A2") <> "" Then
        .Range("B2").Copy
        Sheets("DN").Range("D5").PasteSpecial (xlPasteValues)
        Application.CutCopyMode = False
    End If
End With
End Sub

phuyen89 · 11/7/17

befaint đã viết:
PHP:

Sub Copy() With Sheets("Pickticket") If .Range("A2") <> "" Then .Range("B2").Copy Sheets("DN").Range("D5").PasteSpecial(xlPasteValues) End With End Sub

Em chạy thử thì nó bị lỗi, Em sửa lại thế này thì hết.
http://prntscr.com/fubvh5

PHP:

Sub Copy()
With Sheets("Pickticket")
    If .Range("A2") <> "" Then .Range("B2").Copy
End With
Sheets("DN").Range("D5").PasteSpecial (xlPasteValues)
End Sub

NguyenNgocThuHien · 11/7/17

phuyen89 đã viết:
Em chạy thử thì nó bị lỗi, Em sửa lại thế này thì hết.
http://prntscr.com/fubvh5

PHP:

Sub Copy() With Sheets("Pickticket") If .Range("A2") <> "" Then .Range("B2").Copy End With Sheets("DN").Range("D5").PasteSpecial (xlPasteValues) End Sub

Có được không vậy ta, nếu A2 rỗng, lệnh copy sẽ không được thực hiện, mà đằng sau vẫn ra lệnh dán. Ghép lệnh copy và paste vào trong "If" có lẽ sẽ ổn hơn.

phuyen89 · 11/7/17

NguyenNgocThuHien đã viết:
Có được không vậy ta, nếu A2 rỗng, lệnh copy sẽ không được thực hiện, mà đằng sau vẫn ra lệnh dán. Ghép lệnh copy và paste vào trong "If" có lẽ sẽ ổn hơn.

Hoàn toàn chính xác, em copy đưa ra mà quên suy nghĩ.Nên đưa nó vào trong cụm If.

mhieuit · 11/7/17

Em cám ơn tất cả ACE hỗ trợ phần VBA code trên, hiện tại em đã thực hiện thành công như bên dưới:

Mã:

Sub copy()
Sheets("Pickticket").Select
Dim i As Integer
    For i = 2 To 20
        If Sheets("Pickticket").Range("A" & i).Value <> Empty Then
            Sheets("Pickticket").Range("B" & i).copy
            Sheets("DN").Range("D5").PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            Sheets("DN").Select
            Sheets("DN").copy after:=Sheets(4)
        End If
    Next i
End Sub

befaint · 11/7/17

mhieuit đã viết:
Em cám ơn tất cả ACE hỗ trợ phần VBA code trên, hiện tại em đã thực hiện thành công như bên dưới:

Mã:

Sub copy() Sheets("Pickticket").Select Dim i As Integer For i = 2 To 20 If Sheets("Pickticket").Range("A" & i).Value <> Empty Then Sheets("Pickticket").Range("B" & i).copy Sheets("DN").Range("D5").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False Sheets("DN").Select Sheets("DN").copy after:=Sheets(4) End If Next i End Sub

- Cho code vào thẻ [ code]
- Bỏ cái .select đi đỡ nặng.
- Nghiên cứu dùng mảng xem

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

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

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

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

Chuyên gia GPE

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

Huyền thoại GPE

Cute Black Cat

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

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

Huyền thoại GPE

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

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

Thành viên mới

Thành viên mới

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

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

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

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

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

File đính kèm

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

Cute Black Cat

File đính kèm

Chuyên gia GPE

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

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

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

Cute Black Cat

Cute Black Cat

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

File đính kèm

Thành viên mới

GPE - My love

Thành viên mới

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

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

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

File đính kèm

Thành viên mới

File đính kèm

Chuyên gia GPE

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

File đính kèm

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

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

Chuyên gia GPE

Thành viên mới

GPE - My love

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

Thành viên mới

Thành viên mới

GPE - My love

Thành viên mới

Thành viên mới

==(^o^)==

Thành viên gắn bó

==(^o^)==

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

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

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

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

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

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

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

Chuyên gia GPE

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

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

GPE - My love

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

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

Thành viên mới

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

Thành viên mới

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

Thành viên mới

File đính kèm