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

Liên hệ QC

maytinhvp01

Thành viên thường trực
Tham gia
27/7/13
Bài viết
390
Được thích
179
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]
 
Chỉnh sửa lần cuối bởi điều hành viên:
Cần gì phải trùng.
Mã:
Dim arrReMain As Variant
    arrReMain = Sheet1.Range("E4:E" & iLastRow).Value
    'Khi sử dụng thì điều chỉnh chỉ số cho phù hợp thôi
    'Ví dụ code của bạn dùng arrReMain(i) thì bây giờ là arrReMain(i -3, 1)
hic.. lúc đó phải nhớ ... không thì lại khổ, còn nếu trùng thì dễ hình dung và làm không phải suy nghĩ ... nhớ ... và chỉnh
 
Upvote 0
mọi người cho mình hỏi mình đang ở file excel A, và có 1 Addins (trong Addins có form "Userform1")
vậy code ở file A viết như thế nào để gọi Userform1.show lên được (ThisWorkBook của Addins mình đổi tên thành TWBook rồi)
 
Upvote 0
Thử kiểm tra các GiaTri
Mã:
  eRow = Sheet1.Range("E" & Rows.Count).End(xlUp).Row
  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
Máy tôi bị lỗi ngay dòng ReDim.
 
Upvote 0
Máy tôi bị lỗi ngay dòng ReDim.
dạ máy em cũng vậy....
Nhiều bài quá chắc mấy bạn bỏ qua. Đây là tôi viết ở bài #2.677
ReDim Preserve arrReMain(1 To erow - 3) nó mới chịu

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.
 
Upvote 0
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
Mã:
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)
 
Upvote 0
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
Mã:
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!
 
Upvote 0
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à...
 
Upvote 0
Upvote 0
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 :|
 
Upvote 0
Không có dữ liệu eRow<4 sẽ báo lổi
Mã:
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
 
Upvote 0
Mã:
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)

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

""":::":\ _)()(-
 
Upvote 0
Mã:
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!
 
Upvote 0
Mã:
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
 
Upvote 0
hàm của bạn tôi chỉnh lại :
Mã:
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:
Mã:
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 ạ ?
 

File đính kèm

  • Untitled.png
    Untitled.png
    16.9 KB · Đọc: 7
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
Web KT
Back
Top Bottom