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

huuthang_bd

Chuyên gia GPE
Tham gia ngày
10 Tháng chín 2008
Bài viết
7,953
Được thích
9,292
Điểm
860
Nơi ở
TP.HCM
Dạ thầy coi lại cái https://www.giaiphapexcel.com/diendan/threads/chia-số-lượng-các-cỡ-theo-điều-kiện-để-đóng-thùng.151217/page-3 ở bài #48.
Em làm thế là do muốn trùng số hàng trong bản tính luô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)
 

thnghiachau

Thành viên tiêu biểu
Tham gia ngày
14 Tháng chín 2009
Bài viết
705
Được thích
560
Điểm
860
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
 

Mutants Men

Thành viên thường trực
Tham gia ngày
30 Tháng mười hai 2015
Bài viết
348
Được thích
231
Điểm
210
Tuổi
28
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)
 

HieuCD

Chuyên gia GPE
Tham gia ngày
14 Tháng chín 2010
Bài viết
7,287
Được thích
14,355
Điểm
1,860
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
 

huuthang_bd

Chuyên gia GPE
Tham gia ngày
10 Tháng chín 2008
Bài viết
7,953
Được thích
9,292
Điểm
860
Nơi ở
TP.HCM
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.
 

Maika8008

Thành viên từ sao Hỏa
Tham gia ngày
12 Tháng sáu 2020
Bài viết
587
Được thích
498
Điểm
85
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.
 

thnghiachau

Thành viên tiêu biểu
Tham gia ngày
14 Tháng chín 2009
Bài viết
705
Được thích
560
Điểm
860
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)
 

Maika8008

Thành viên từ sao Hỏa
Tham gia ngày
12 Tháng sáu 2020
Bài viết
587
Được thích
498
Điểm
85
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!
 

thnghiachau

Thành viên tiêu biểu
Tham gia ngày
14 Tháng chín 2009
Bài viết
705
Được thích
560
Điểm
860
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

Chuyên gia GPE
Tham gia ngày
10 Tháng chín 2008
Bài viết
7,953
Được thích
9,292
Điểm
860
Nơi ở
TP.HCM
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

Chuyên gia GPE
Tham gia ngày
14 Tháng chín 2010
Bài viết
7,287
Được thích
14,355
Điểm
1,860
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
 

Maika8008

Thành viên từ sao Hỏa
Tham gia ngày
12 Tháng sáu 2020
Bài viết
587
Được thích
498
Điểm
85
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

""":::":\ _)()(-
 

Love GPE

Thành viên mới
Tham gia ngày
17 Tháng hai 2020
Bài viết
34
Được thích
14
Điểm
15
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!
 

Maika8008

Thành viên từ sao Hỏa
Tham gia ngày
12 Tháng sáu 2020
Bài viết
587
Được thích
498
Điểm
85
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
 

Duong.bach

Thành viên mới
Tham gia ngày
28 Tháng ba 2020
Bài viết
18
Được thích
2
Điểm
15
Tuổi
28
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

huuthang_bd

Chuyên gia GPE
Tham gia ngày
10 Tháng chín 2008
Bài viết
7,953
Được thích
9,292
Điểm
860
Nơi ở
TP.HCM
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.
 

xuanquocxd

Thành viên mới
Tham gia ngày
19 Tháng chín 2012
Bài viết
1
Được thích
0
Điểm
363
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
-------
 
Top Bottom