Chuyên đề giải đáp những thắc mắc về code VBA

[maytinhvp01]

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]

 

[thnghiachau]

Và tiện đây cũng hỏi lại bạn @thnghiachau, sao bạn không muốn dùng vòng lặp For...Next? Tôi có hỏi ở trên nhưng chắc bạn cũng không thấy.

Dạ, mình thấy và mình trả lời cho bác @huuthang_bd ở bài #2680 ...
Và code cuối cùng OK là của Bác @HieuCD

Dim arrReMain
    iLastRow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row 
    arrReMain = Application.Transpose(Sheet1.Range("E4:E" & iLastRow).Value)
    ReDim Preserve arrReMain(4 To iLastRow)

 

[Maika8008]

Dạ, mình thấy và mình trả lời cho bác @huuthang_bd ở bài #2680 ...
Và code cuối cùng OK là của Bác @HieuCD

Dim arrReMain
    iLastRow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
    arrReMain = Application.Transpose(Sheet1.Range("E4:E" & iLastRow).Value)
    ReDim Preserve arrReMain(4 To iLastRow)

bài #2.680 trả lời cho tại sao là số 4. Còn bạn hỏi ngay từ đầu là có cách gì khác ngoài việc dùng vòng lặp For!

 

[thnghiachau]

Tại sao lại không muốn dùng For bạn? Nếu thực sự không muốn vậy thì dùng do ... loop

Xin lỗi ... ngàn lần xin lỗi anh... vi em chưa trả lời anh... mong anh rộng lòng tha thứ...
em không muốn dùng vòng lặp (For hay Loop, hay do-Until...) là vì em không muốn code tương tác nhiều trên sheet.
anh xem bài #2680, em có cái link tới bài mà em đã làm cho một bạn trên GPE này.
Trước kia em làm không dùng mảng, sau đó thầy @huuthang_bd nói làm thế thì code chậm nên em đã đổi dùng mảng và đúng là chạy nhanh hơn rất nhiều.
Và nhân tiện em có khúc code mà đã hỏi, nó là tương tác trực tiếp với sheet nhiều lần qua vòng lặp For nên tiện em hỏi luôn đó mà...

 

[huuthang_bd]

nhưng mà đổi
Dim arrReMain() As Integer
thành
Dim arrReMain
thì OK

Máy tôi vẫn lỗi.

 

[thnghiachau]

Máy tôi vẫn lỗi.

thế thì em botay... vì em chạy vèo vèo...
Hic... có vấn đề nào khác ở đây mà bác @huuthang_bd muốn đề cập ở đây mà "chưa nói ra" không nhỉ....
Phải đưa vào mục "thắc mắc biết hỏi ai" thôi...

 

[huuthang_bd]

thế thì em botay... vì em chạy vèo vèo...

Đã kiểm tra lại và code đó chạy ok. Do lúc nãy cột A của tôi không có dữ liệu nên bị lỗi .

Hic... có vấn đề nào khác ở đây mà bác @huuthang_bd muốn đề cập ở đây mà "chưa nói ra" không nhỉ....
Phải đưa vào mục "thắc mắc biết hỏi ai" thôi...

Bạn muốn đề cập đến vấn đề gì? Bâng quơ vậy ai biết thế nào :|

 

[HieuCD]

Máy tôi vẫn lỗi.

Không có dữ liệu eRow<4 sẽ báo lổi

Sub XYZ()
  Dim arrReMain, eRow&, i&, GiaTri
 
  eRow = Sheet1.Range("E" & Rows.Count).End(xlUp).Row
  If eRow < 4 Then MsgBox ("Khong co du lieu"): Exit Sub
  arrReMain = Application.Transpose(Sheet1.Range("E4:E" & eRow).Value)
  ReDim Preserve arrReMain(4 To eRow)
  For i = 4 To eRow
      GiaTri = arrReMain(i) ' kiem tra ket qua
  Next i
End Sub

 

[Maika8008]

Dim arrReMain
    iLastRow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
    arrReMain = Application.Transpose(Sheet1.Range("E4:E" & iLastRow).Value)
    ReDim Preserve arrReMain(4 To iLastRow)

Máy tôi vẫn lỗi.

Nếu dùng Dim arrReMain thì không lỗi

Dim arrReMain() thì bị lỗi out of range khi dùng ReDim Preserve arrReMain(4 To iLastRow),

nhưng dùng ReDim Preserve arrReMain(1 To iLastRow -3) thì lại không lỗi

 

[Love GPE]

Sub Sort_Sh18()
Dim i As Long
i = Sheet18.Range("C" & Rows.Count).End(xlUp).Row
Rows("2:" & i).Sort [B2], 1
End Sub

Đoạn code trên Em đang sắp xếp dữ liệu với 1 cột (cột B). Anh Chị giúp Em có cách nào để sắp xếp thêm được cột C, D. Em cảm ơn!

 

[Maika8008]

Sub Sort_Sh18()
Dim i As Long
i = Sheet18.Range("C" & Rows.Count).End(xlUp).Row
Rows("2:" & i).Sort [B2], 1
End Sub

Đoạn code trên Em đang sắp xếp dữ liệu với 1 cột (cột B). Anh Chị giúp Em có cách nào để sắp xếp thêm được cột C, D. Em cảm ơn!

Range("B2:d" & i).Sort [B2], 1

 

[Duong.bach]

hàm của bạn tôi chỉnh lại :

Function Vlookup_nhieu_gia_tri(ByVal rngRangeFind As Range, ByVal vWhatFind As Variant, Optional iLookAt As Integer = 2)
Dim cllResultFind As Range, strFirstAddress As String, strResult As String
    If Not rngRangeFind Is Nothing Then
        With rngRangeFind
            'Find All In Cell => iLookAt=1, Find Part of Cell=> iLookAt=2
            Set cllResultFind = .Find(What:=vWhatFind, After:=.Cells(.Cells.Count), LookIn:=xlValues, LookAt:=iLookAt, _
                                      SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
            If cllResultFind Is Nothing Then
                Exit Function
            Else
                strFirstAddress = cllResultFind.Address
                Do
                    strResult = IIf(strResult <> "", strResult & "{|}", "") & cllResultFind.Value
                    Set cllResultFind = .FindNext(cllResultFind)
                Loop While Not cllResultFind Is Nothing And cllResultFind.Address <> strFirstAddress
            End If
        End With
    End If
    If strResult <> "" Then Vlookup_nhieu_gia_tri = Split(strResult, "{|}")
End Function

Sử dụng như sau:

Dim arrResultFind
    'Find All In Cell => iLookAt=1, Find Part of Cell=> iLookAt=2
    arrResultFind = Vlookup_nhieu_gia_tri(Sheet2.Range("A1:A30"), Sheet2.Range("C1").Value, 2) 'Tìm phần trong cell
    arrResultFind = Vlookup_nhieu_gia_tri(Sheet2.Range("A1:A30"), Sheet2.Range("C1").Value, 1) 'Tìm toàn bộ trong Cell

Bạn chú ý: nếu tìm chính xác toàn bộ giá trị trong cell thì iLookAt=1 , và nếu chỉ tìm một phần trong cell thì iLookAt=2
Ví dụ: tìm trong A1:A5 ở Sheet2 với giá trị ở ô C1 là "BA"

BBA

BBC

CAA

CBA

CCC

=> tìm chính xác toàn bộ trong Cell: Vlookup_nhieu_gia_tri(Sheet2.Range("A1:A5"), Sheet2.Range("C1").Value, 1) thì sẽ không có kết quả
=> tìm một phần trong Cell: Vlookup_nhieu_gia_tri(Sheet2.Range("A1:A5"), Sheet2.Range("C1").Value, 2) thì kết quả là 2 giá trị "BBA" và "CBA"

Cám ơn bác, em đã copy code vảo module, nhưng gõ lệnh trong excel lại ko ra được kết quả, em làm như này có gì sai ko ạ ?

 

[huuthang_bd]

Nếu dùng Dim arrReMain thì không lỗi

Dim arrReMain() thì bị lỗi out of range khi dùng ReDim Preserve arrReMain(4 To iLastRow),

nhưng dùng ReDim Preserve arrReMain(1 To iLastRow -3) thì lại không lỗi

Sao bạn cứ lặp đi lặp lại mãi cái dòng code này vậy nhỉ.
Dòng code của bạn không lỗi nhưng nó hoàn toàn vô dụng. Và vì nó vô dụng nên không thể nào đáp ứng nhu cầu của người hỏi được.

 

[Maika8008]

chào các cao nhận ạ, e có sưu tầm được 1 file vba về lấy link trong thư mục ra excel. tuy nhiên kết quả mặt định gán về cột A. nhờ các cao nhân chỉnh sửa gán về cột H được không ạ.
Cảm ơn các ạnh nhiều, mong nhận được sự giúp đỡ ạ
------
Sub Hyper()
Dim xFSO As Object
Dim xFolder As Object
Dim xFile As Object
Dim xFiDialog As FileDialog
Dim xPath As String
Dim I As Integer
Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
If xFiDialog.Show = -1 Then
xPath = xFiDialog.SelectedItems(1)
End If
Set xFiDialog = Nothing
If xPath = "" Then Exit Sub
Set xFSO = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFSO.GetFolder(xPath)
For Each xFile In xFolder.Files
I = I + 1
ActiveSheet.Hyperlinks.Add Cells(I, 1), xFile.Path, , , xFile.Name
Next
End Sub
-------

Sửa số 1 là A thành số cột bạn muốn 8 là H tại dòng ActiveSheet.Hyperlinks.Add Cells(I, 1), xFile.Path, , , xFile.Name

 

[thnghiachau]

chào các cao nhận ạ, e có sưu tầm được 1 file vba về lấy link trong thư mục ra excel. tuy nhiên kết quả mặt định gán về cột A. nhờ các cao nhân chỉnh sửa gán về cột H được không ạ.
Cảm ơn các ạnh nhiều, mong nhận được sự giúp đỡ ạ
------
Sub Hyper()
Dim xFSO As Object
Dim xFolder As Object
Dim xFile As Object
Dim xFiDialog As FileDialog
Dim xPath As String
Dim I As Integer
Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
If xFiDialog.Show = -1 Then
xPath = xFiDialog.SelectedItems(1)
End If
Set xFiDialog = Nothing
If xPath = "" Then Exit Sub
Set xFSO = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFSO.GetFolder(xPath)
For Each xFile In xFolder.Files
I = I + 1
ActiveSheet.Hyperlinks.Add Cells(I, 1), xFile.Path, , , xFile.Name
Next
End Sub
-------

bạn coi cái dòng này: ActiveSheet.Hyperlinks.Add Cells(I, 1), xFile.Path, , , xFile.Name
chỉnh lại cái in đậm theo bạn muốn

 

[huuthang_bd]

Sửa thẳng thành chữ H luôn để sau này bạn có muốn sửa thì còn nhớ.

Sub Hyper()
    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim xFiDialog As FileDialog
    Dim xPath As String
    Dim I As Integer
    Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
    If xFiDialog.Show = -1 Then
        xPath = xFiDialog.SelectedItems(1)
    End If
    Set xFiDialog = Nothing
    If xPath = "" Then Exit Sub
    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(xPath)
    For Each xFile In xFolder.Files
        I = I + 1
        ActiveSheet.Hyperlinks.Add Cells(I, "H"), xFile.Path, , , xFile.Name
    Next
End Sub

 

[Love GPE]

Em có đoạn code dưới đây. Em đang tập tành lấy tên khách hàng từ listbox vào textbox.
Hiện tại khi em gõ tên khách hàng vào textbox -> đã thấy khách hàng ở dưới listbox rồi. Nhưng em dùng phím mũi tên để di chuyển xuống listbox chọn khách hàng thì ko xuống được. Em đang thử để setfocus cho lisbox (chỗ chữ em tô đỏ ở dưới code) - thì chưa kịp gõ đến chữ thứ 2 thì nó đã chuyển xuống lisbox mất rồi.
Em mong muốn GPE giúp Em .... sau khi gõ tìm kiếm khách hàng ở textbox -> thấy khách hàng cần tìm thì bấm mũi tên xuống -> con trỏ chuột sẽ chuyển xuống listbox để chọn khách hàng -> Bấm enter thì khách hàng sẽ được chọn vào textbox. Mong GPE giúp đỡ Em với ạ. Cảm ơn GPE rất nhiều!



Private Sub LxB_KhachHang_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = vbKeyReturn Then
TxB_KhachHang.Value = LxB_KhachHang.Value
LxB_KhachHang.Height = 0
End If
End Sub

Private Sub TxB_KhachHang_change()
LxB_KhachHang.Clear
LxB_KhachHang.Visible = True
LxB_KhachHang.Height = 150
LxB_KhachHang.Width = 400
LxB_KhachHang.List = Filter(WorksheetFunction.Transpose(Range("Name_KhachHang")), TxB_KhachHang.Value, True, vbTextCompare)
LxB_KhachHang.SetFocus
End Sub

 

[ptm0412]

Em có đoạn code dưới đây. Em đang tập tành lấy tên khách hàng từ listbox vào textbox.
Hiện tại khi em gõ tên khách hàng vào textbox -> đã thấy khách hàng ở dưới listbox rồi. Nhưng em dùng phím mũi tên để di chuyển xuống listbox chọn khách hàng thì ko xuống được. Em đang thử để setfocus cho lisbox (chỗ chữ em tô đỏ ở dưới code) - thì chưa kịp gõ đến chữ thứ 2 thì nó đã chuyển xuống lisbox mất rồi.
Em mong muốn GPE giúp Em .... sau khi gõ tìm kiếm khách hàng ở textbox -> thấy khách hàng cần tìm thì bấm mũi tên xuống -> con trỏ chuột sẽ chuyển xuống listbox để chọn khách hàng -> Bấm enter thì khách hàng sẽ được chọn vào textbox. Mong GPE giúp đỡ Em với ạ. Cảm ơn GPE rất nhiều!

Câu lệnh setFocus để trong thủ tục KeyDown của textbox, Keycode = 40. Xuống listBox rồi nhấn enter thì cũng dùng thủ tục keyDown, KeyCode = 13

 

[Love GPE]

Câu lệnh setFocus để trong thủ tục KeyDown của textbox, Keycode = 40. Xuống listBox rồi nhấn enter thì cũng dùng thủ tục keyDown, KeyCode = 13

Em cảm ơn Thầy ptm0412 rất nhiều! Em sửa lệnh như chỗ tô mầu xanh. Để setfocus trong thủ tục Keydown với điều kiện keycode = 40 thì setfocus xuống lisbox được rồi Thầy ạ.

Private Sub LxB_KhachHang_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = vbKeyReturn Then
TxB_KhachHang.Value = LxB_KhachHang.Value
LxB_KhachHang.Height = 0
End If
End Sub
Private Sub TxB_KhachHang_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
LxB_KhachHang.Clear
LxB_KhachHang.Visible = True
LxB_KhachHang.Height = 150
LxB_KhachHang.Width = 400
LxB_KhachHang.List = Filter(WorksheetFunction.Transpose(Range("Name_KhachHang")), TxB_KhachHang.Value, True, vbTextCompare)
If KeyCode = 40 Then
LxB_KhachHang.SetFocus
End If
End Sub

 

[moihocvba]

Mọi người cho hỏi, trong sheet để ngăn sự kiện chạy thì mình dùng Application.EnableEvents = False, còn trong userform để ngăn sự kiện Textbox1_Change thì mình dùng lệnh nào ạ?
Để trong một số trường hợp mình gõ vào textbox1 đó thì lệnh Textbox1_Change ko thực thi nữa đó ạ?
Cảm ơn đã giải đáp!

 

[thnghiachau]

Mọi người cho hỏi, trong sheet để ngăn sự kiện chạy thì mình dùng Application.EnableEvents = False, còn trong user để ngăn sự kiện Textbox1_Change thì mình dùng lệnh nào ạ?
Để trong một số trường hợp mình gõ vào textbox1 đó thì lệnh Textbox1_Change ko thực thi nữa đó ạ?
Cảm ơn đã giải đáp!

Hình như là không có thì phải...
Bạn tạo biến Public (vd: blEnableEvents chẳng hạn)
và đầu mỗi sự kển bạn kiểm tra biến này
If Not blblEnableEvents then exit sub