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

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]

batman1 · 11/1/21

Mọi code bạn cũng từng biết, từng dùng

Mã:

Sub test()
Dim lastRow As Long, r As Long, filename()
    With ThisWorkbook.Worksheets("Sheet1")
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        filename = .Range("A1:A" & lastRow + 1).Value    '  lấy dư 1 dòng cuoi
    End With
    For r = 1 To UBound(filename, 1) - 1    ' không xét dòng lấy dư
        If Not IsEmpty(filename(r, 1)) Then Debug.Print filename(r, 1)
    Next r
End Sub

Muốn đường dẫn đầy đủ thì If Not IsEmpty(filename(r, 1)) Then Debug.Print ThisWorkbook.Path & "\" & filename(r, 1)
-------------
Có thể dùng GetOpenFilename. Hoặc Windows API, nhưng bạn không biết Windows API.

Mã:

Sub test2()
Dim filename, fNames
    fNames = Application.GetOpenFilename("Excel Files (*.xlsx; *.xlsm; *.xlsb), *.xlsx; *.xlsm; *.xlsb", MultiSelect:=True)
    If IsArray(fNames) Then
        For Each filename In fNames
            Debug.Print filename
        Next filename
    End If
End Sub

Hoàng Nhật Phương · 11/1/21

befaint đã viết:
Đọc không tài nào hiểu nổi.
Mình quên cái mớ code kia đi. Mô tả cái yêu cầu, cái mình cần ấy.

Dạ, OT xin gửi mô tả bằng hình ảnh để Bạn @befaint hiểu thêm ạ.

Bài đã được tự động gộp: 11/1/21

batman1 đã viết:
Mọi code bạn cũng từng biết, từng dùng

Mã:

Sub test() Dim lastRow As Long, r As Long, filename() With ThisWorkbook.Worksheets("Sheet1") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row filename = .Range("A1:A" & lastRow + 1).Value ' lấy dư 1 dòng cuoi End With For r = 1 To UBound(filename, 1) - 1 ' không xét dòng lấy dư If Not IsEmpty(filename(r, 1)) Then Debug.Print filename(r, 1) Next r End Sub

Muốn đường dẫn đầy đủ thì If Not IsEmpty(filename(r, 1)) Then Debug.Print ThisWorkbook.Path & "\" & filename(r, 1)
-------------
Có thể dùng GetOpenFilename. Hoặc Windows API, nhưng bạn không biết Windows API.

Mã:

Sub test2() Dim filename, fNames fNames = Application.GetOpenFilename("Excel Files (*.xlsx; *.xlsm; *.xlsb), *.xlsx; *.xlsm; *.xlsb", MultiSelect:=True) If IsArray(fNames) Then For Each filename In fNames Debug.Print filename Next filename End If End Sub

Bác ơi, có lẽ là mô tả của con chưa rõ ràng nên Bác và Bạn @befaint mới chưa hiểu hết vấn đề con muốn ạ.
Với 'Application.FileDialog(msoFileDialogFilePicker)'
Có lẽ vấn đề con muốn là xử lý ở đoạn này để nó không xuất hiện cái cửa sổ để lựa chọn file Bác ạ:

Mã:

If .Show = -1 Then
        For Each vrtSelectedItem In .SelectedItems
           MsgBox "Selected item's path: " & vrtSelectedItem
        Next vrtSelectedItem
    Else
    End If

Nghĩa là với đoạn code trên có thể bỏ đi để thay bằng đoạn khác mà code tự lựa chọn luôn trong A1,A2,A3 được không Bác.
Hay là có thể dùng cách nào đó thay 'Application.FileDialog(msoFileDialogFilePicker)' ví dụ dùng 'CreateObject("Scripting.FileSystemObject")' ấy ạ
Hic hic con kém code nên giải thích về code cũng khiến mọi người khó hiểu,...
---
Hic không hiểu do diễn đàn hay do máy tính của con mà trình duyệt nó 'nhập nhoạng' loạn hết cả lên hic chic chỉ xem được có tý tẹo nội dung còn bị che hết một khoảng ở trên.

befaint · 12/1/21

NHN_Phương đã viết:
Dạ, OT xin gửi mô tả bằng hình ảnh để Bạn @befaint hiểu thêm ạ.

Sao cô cứ lộn tùng phèo vậy?

Lúc trước kêu có sẵn danh sách ở cột A rồi:

Giờ lại kêu lấy danh sách điền vào cột A?

Đã bảo là quên cái mớ code đó đi.
Kiểu kia thì cứ thế kiểm tra xem danh sách các files ở cột A có tồn tại hay không, nếu có thì chiến luôn thế thôi.

Mà túm lại nêu cái iêu cầu cuối cùng ấy. Chắc đoạn này mới là màn dạo đầu thôi chứ gì.

Hoàng Nhật Phương · 12/1/21

befaint đã viết:
Sao cô cứ lộn tùng phèo vậy?

Lúc trước kêu có sẵn danh sách ở cột A rồi:

View attachment 252828

Giờ lại kêu lấy danh sách điền vào cột A?

View attachment 252827

Đã bảo là quên cái mớ code đó đi.
Kiểu kia thì cứ thế kiểm tra xem danh sách các files ở cột A có tồn tại hay không, nếu có thì chiến luôn thế thôi.

Mà túm lại nêu cái iêu cầu cuối cùng ấy. Chắc đoạn này mới là màn dạo đầu thôi chứ gì.

Hic không phải là lấy sự lựa chọn để điền vào cột A đâu ạ, mà là cột A chưa là gì mà nó đã có sẵn rồi, giờ chỉ gọi nó lên để dùng để chiến luôn ấy ạ ahii.
Vâng đúng là khúc này mới chỉ dạo đầu thôi ạ, nó sẽ tìm trong cột A có bao nhiêu file trong cột A rồi mở lên làm gì gì đó rồi đóng lại bạn ạ.
Vâng đúng bạn phải kiểm tra danh sách có tồn tại hay không nếu có thì mở nó lên.
Và cái OT muốn hỏi có sử dụng với phương phâp dùng fileDialog... được không hay phải dùng cách khác ạ.
Hâyzzz hic chết mất thôi (OT đang tự trách mình Bạn ạ)

befaint · 12/1/21

NHN_Phương đã viết:
Và cái OT muốn hỏi có sử dụng với phương phâp dùng fileDialog... được không

Không được. FileDialog dịch ra là cái hộp thoại chọn File thôi, chứ nó chẳng làm gì sứt.

PHP:

Public Function file_exists(ByVal file_path As String) As Boolean
    ' Rreturns True if file exists, else returns False

    If Len(file_path) = 0 Then file_exists = False: Exit Function
    Static FSo As Object
    If FSo Is Nothing Then Set FSo = CreateObject("Scripting.FileSystemObject")
    file_exists = FSo.FileExists(file_path)
End Function

Cách áp dụng:

PHP:

Sub vidu()
Dim curr_path as string, item as variant, file_path as string
curr_path = thisworkbook.path & "\"
For each item in Range("A1:A10").value2
file_path = curr_path & item
if file_exists(file_path)= true then
'chiến luôn
End if
Next item
End sub

Hoàng Nhật Phương · 12/1/21

befaint đã viết:
Sao cô cứ lộn tùng phèo vậy?

Lúc trước kêu có sẵn danh sách ở cột A rồi:

View attachment 252828

Giờ lại kêu lấy danh sách điền vào cột A?

View attachment 252827

Đã bảo là quên cái mớ code đó đi.
Kiểu kia thì cứ thế kiểm tra xem danh sách các files ở cột A có tồn tại hay không, nếu có thì chiến luôn thế thôi.

Mà túm lại nêu cái iêu cầu cuối cùng ấy. Chắc đoạn này mới là màn dạo đầu thôi chứ gì.

à trong hình ảnh OT gửi nói cái đoạn điền vào cột A đó là đã điền bằng tay trước khi chạy code rồi (nghĩa là nó có sẵn code không tự điền vào đây mà chỉ tìm trong này thôi) đúng như bạn hiểu lúc đầu, hic do OT mô tả sai, giờ bạn gửi lại mới để ý kỹ hơn.
Oài, thế nào OT cũng còn bị một trận mắng nữa của Bác ấy nữa hic ..
Thôi OT ngủ đây ạ, chúc mọi người ngủ ngon ạ.. hic hic
---

Bài đã được tự động gộp: 12/1/21

befaint đã viết:

Không được. FileDialog dịch ra là cái hộp thoại chọn File thôi, chứ nó chẳng làm gì sứt.

PHP:

Public Function file_exists(ByVal file_path As String) As Boolean
    ' Rreturns True if file exists, else returns False

    If Len(file_path) = 0 Then file_exists = False: Exit Function
    Static FSo As Object
    If FSo Is Nothing Then Set FSo = CreateObject("Scripting.FileSystemObject")
    file_exists = FSo.FileExists(file_path)
End Function

Cách áp dụng:

PHP:

Sub vidu()
Dim curr_path as string, item as variant, file_path as string
curr_path = thisworkbook.path & "\"
For each item in Range("A1:A10").value2
file_path = curr_path & item
if file_exists(file_path)= true then
'chiến luôn
End if
Next item
End sub

Hic OT vừa gửi xong thì thấy bài này của Bạn, cảm ơn Bạn nhiều nhé, như vậy là OT cũng đã nghĩ đúng FileDialog là ko thể ẩn cửa sổ đi được OT tìm kiếm đoạn code nào cũng đề cập đến show (xuất hiện cái cửa sổ).. về code của Bạn, xin phép mai OT xem và ứng dụng thử nếu có vấn đề gì OT sẽ thông tin lại ạ.
Chúc Bạn ngủ ngon @befaint

batman1 · 12/1/21

NHN_Phương đã viết:
Bác ơi, có lẽ là mô tả của con chưa rõ ràng nên Bác và Bạn @befaint mới chưa hiểu hết vấn đề con muốn ạ.
Với 'Application.FileDialog(msoFileDialogFilePicker)'
Có lẽ vấn đề con muốn là xử lý ở đoạn này để nó không xuất hiện cái cửa sổ để lựa chọn file Bác ạ:

Mã:

If .Show = -1 Then For Each vrtSelectedItem In .SelectedItems MsgBox "Selected item's path: " & vrtSelectedItem Next vrtSelectedItem Else End If

Nghĩa là với đoạn code trên có thể bỏ đi để thay bằng đoạn khác mà code tự lựa chọn luôn trong A1,A2,A3 được không Bác.

NHN_Phương đã viết:
mà là cột A chưa là gì mà nó đã có sẵn rồi, giờ chỉ gọi nó lên để dùng để chiến luôn ấy ạ

Tôi không hiểu bạn nói gì nữa. Theo bạn giải thích vòng vo thì bây giờ bạn muốn dùng FileDialog nhưng bỏ cửa số chọn tập tin và bỏ đoạn If .Show = -1 Then ... End If vì tên các tập tin lấy từ cột A. Trời ạ, FileDialog chỉ dùng với mục đích lấy tên các tập tin được chọn. Nếu không chọn nữa mà lấy các tên từ cột A thì đá đít thằng FileDialog chứ sao lại "dùng FileDialog nhưng bỏ If .Show = -1 Then ... End If"? Đã không phải chọn thì muôn đời không dùng FileDialog, bạn có hiểu điều đơn giản ấy không?

chiến luôn ở bài #2889 là hiển thị ở cửa sổ Immediate vì bạn viết ở bài #2884

mở hay ghi tên file đã được lựa chọn đó ra cửa sổ Immediate

Còn nếu muốn kiểm tra tồn tại rồi mở trong Excel thì

Mã:

Sub test()
Dim lastRow As Long, r As Long, filename(), fso As Object
    With ThisWorkbook.Worksheets("Sheet1")
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        filename = .Range("A1:A" & lastRow + 1).Value
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")    ' (A)
    Application.ScreenUpdating = False
    For r = 1 To UBound(filename, 1) - 1
        If Not IsEmpty(filename(r, 1)) Then
            If fso.FileExists(ThisWorkbook.Path & "\" & filename(r, 1)) Then Workbooks.Open ThisWorkbook.Path & "\" & filename(r, 1)
        End If
    Next r
    Application.ScreenUpdating = True
    Set fso = Nothing
End Sub

(A) - tạo đối tượng fso lớp (class) FileSystemObject để sau đó dùng phương thức FileExists của nó kiểm tra sự tồn tại của tập tin bất kỳ (không chỉ tập tin Excel - tập tin bất kỳ)

Hoàng Nhật Phương · 12/1/21

batman1 đã viết:
. Tời ạ, FileDialog chỉ dùng với mục đích lấy tên các tập tin được chọn. Nếu không chọn nữa mà lấy các tên từ cột A thì đá đít thằng FileDialog chứ sao lại "dùng FileDialog nhưng bỏ If .Show = -1 Then ... End If"? Đã không phải chọn thì muôn đời không dùng FileDialog, bạn có hiểu điều đơn giản ấy không?

Con chào Bác ạ, vâng chính xác là con hỏi cái này ạ, con không muốn hiện cái lựa chọn ạ.
Dốt code nên giải thích cũng đến khổ mình và khổ cả người khác Bác nhỉ.

batman1 đã viết:

chiến luôn ở bài #2889 là hiển thị ở cửa sổ Immediate vì bạn viết ở bài #2884
Còn nếu muốn kiểm tra tồn tại rồi mở trong Excel thì

Mã:

Sub test()
Dim lastRow As Long, r As Long, filename(), fso As Object
    With ThisWorkbook.Worksheets("Sheet1")
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        filename = .Range("A1:A" & lastRow + 1).Value
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")    ' (A)
    Application.ScreenUpdating = False
    For r = 1 To UBound(filename, 1) - 1
        If Not IsEmpty(filename(r, 1)) Then
            If fso.FileExists(ThisWorkbook.Path & "\" & filename(r, 1)) Then Workbooks.Open ThisWorkbook.Path & "\" & filename(r, 1)
        End If
    Next r
    Application.ScreenUpdating = True
    Set fso = Nothing
End Sub

Đúng cái con cần rồi Bác, con cảm ơn Bác Siwtom, cảm ơn Bạn @befaint

Hoàng Nhật Phương · 12/1/21

batman1 đã viết:
Tôi không hiểu bạn nói gì nữa. Theo bạn giải thích vòng vo thì bây giờ bạn muốn dùng FileDialog nhưng bỏ cửa số chọn tập tin và bỏ đoạn If .Show = -1 Then ... End If vì tên các tập tin lấy từ cột A. Trời ạ, FileDialog chỉ dùng với mục đích lấy tên các tập tin được chọn. Nếu không chọn nữa mà lấy các tên từ cột A thì đá đít thằng FileDialog chứ sao lại "dùng FileDialog nhưng bỏ If .Show = -1 Then ... End If"? Đã không phải chọn thì muôn đời không dùng FileDialog, bạn có hiểu điều đơn giản ấy không?

chiến luôn ở bài #2889 là hiển thị ở cửa sổ Immediate vì bạn viết ở bài #2884

Còn nếu muốn kiểm tra tồn tại rồi mở trong Excel thì

Mã:

Sub test() Dim lastRow As Long, r As Long, filename(), fso As Object With ThisWorkbook.Worksheets("Sheet1") lastRow = .Cells(Rows.Count, "A").End(xlUp).Row filename = .Range("A1:A" & lastRow + 1).Value End With Set fso = CreateObject("Scripting.FileSystemObject") ' (A) Application.ScreenUpdating = False For r = 1 To UBound(filename, 1) - 1 If Not IsEmpty(filename(r, 1)) Then If fso.FileExists(ThisWorkbook.Path & "\" & filename(r, 1)) Then Workbooks.Open ThisWorkbook.Path & "\" & filename(r, 1) End If Next r Application.ScreenUpdating = True Set fso = Nothing End Sub

(A) - tạo đối tượng fso lớp (class) FileSystemObject để sau đó dùng phương thức FileExists của nó kiểm tra sự tồn tại của tập tin bất kỳ (không chỉ tập tin Excel - tập tin bất kỳ)

Bác ơi , con hỏi thêm với ạ câu lệnh sau:
Workbooks.Open ThisWorkbook.Path & "\" & filename(r, 1)
Mở được các tập tin "*.xls*", nhưng với file PDF thì không, vậy với file PDF thì cú pháp mở file PDF với fso thì như thế nào ạ ?

befaint · 12/1/21

NHN_Phương đã viết:
với file PDF

Mở mọi tập tin theo ứng dụng đã cài đặt mặc định.

PHP:

Call Shell(file_path, vbNormalFocus)

Hoàng Nhật Phương · 12/1/21

befaint đã viết:
Mở mọi tập tin theo ứng dụng đã cài đặt mặc định.

PHP:

Call Shell(file_path, vbNormalFocus)

OT đang tách một phần câu lệnh trên để chuyển thành hàm, ví dụ:

Mã:

Function OpnFile(filename As String)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not IsEmpty(filename) Then
        If fso.fileExists(filename) Then
            If filename Like "*.xls*" Then
                Workbooks.Open filename
            ElseIf filename Like "*.pdf" Then
                Call Shell(filename, vbNormalFocus)
            End If
        End If
    End If
    Set fso = Nothing
End Function

Không biết như vậy có đúng không Bạn @befaint ?

Hoàng Nhật Phương · 12/1/21

NHN_Phương đã viết:
OT đang tách một phần câu lệnh trên để chuyển thành hàm, ví dụ:

Mã:

Function OpnFile(filename As String) Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") If Not IsEmpty(filename) Then If fso.fileExists(filename) Then If filename Like "*.xls*" Then Workbooks.Open filename ElseIf filename Like "*.pdf" Then Call Shell(filename, vbNormalFocus) End If End If End If Set fso = Nothing End Function

Không biết như vậy có đúng không Bạn @befaint ?

A! được rồi , OT làm được rồi ahihi :yahoo:

Mã:

Option Explicit

Function OpenOtherFile(sFile As String)
    Dim sApp As Object
    Set sApp = CreateObject("Shell.Application")
    sApp.Open (sFile)
End Function

Function OpnFile(filename As String)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not IsEmpty(filename) Then
        If fso.fileExists(filename) Then
            If filename Like "*.xls*" Then
                Workbooks.Open filename
            ElseIf filename Like "*.pdf" Then
                OpenOtherFile filename
            End If
        End If
    End If
    Set fso = Nothing
End Function

Sub test()
    Dim r As Long, afile As Variant, fName As String, Wb As Workbook
    On Error GoTo Err_
    Application.ScreenUpdating = True
    Set Wb = ThisWorkbook
    With Wb.Worksheets("Sheet1")
        r = .Cells(Rows.Count, "A").End(xlUp).Row
        afile = .Range("A1:A" & r + 1).Value
    End With
    For r = 1 To UBound(afile, 1) - 1
        fName = Wb.Path & "\" & afile(r, 1)
        OpnFile fName
    Next r
Err_:
    Application.ScreenUpdating = False
    If Err.Number <> 0 Then MsgBox "Error :" & Err.Description, vbCritical, Err.Number
End Sub

befaint · 12/1/21

NHN_Phương đã viết:
Function OpenOtherFile(sFile As String)
Dim sApp As Object
Set sApp = CreateObject("Shell.Application")
sApp.Open (sFile)
End Function

Không cần phải dựng object đó. Dùng luôn lệnh Shell là được rồi.

NHN_Phương đã viết:
Function OpnFile(filename As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If Not IsEmpty(filename) Then
If fso.fileExists(filename) Then
If filename Like "*.xls*" Then
Workbooks.Open filename
ElseIf filename Like "*.pdf" Then
OpenOtherFile filename
End If
End If
End If
Set fso = Nothing
End Function

Lấy cái hàm làm cho ấy.
Khai báo thế kia mỗi lần dùng tới phải dựng lại cái fso mệt.

---

PHP:

Function OpnFile(byval filename As String)
    Const excelExt = "XLS"  '*.xls*
    Const pdfExt = "PDF"  '*.pdf*
    Static fso As Object
    Dim fileExt as string
    If fso is nothing then Set fso = CreateObject("Scripting.FileSystemObject")
    fileExt =  vba.ucase$(fso.GetExtensionName(filename))
    If len(filename) > 0 Then
        If fso.fileExists(filename) Then
            If instr(fileExt, excelExt, vbBinaryCompare) > 0  Then
                Workbooks.Open filename
            ElseIf pdfExt  = fileExt Then
                Call Shell(filename, vbNormalFocus)
            End If
        End If
    End If
    Set fso = Nothing
End Function

Hoàng Nhật Phương · 13/1/21

Xin chào các bạn,
Khi OT muốn copy 1 dòng được lựa chọn, OT làm như sau:

Mã:

Sub ThemDong()
    Dim i As Integer
    i = Selection.Row
    Rows(i & ":" & i).Copy
    Rows(i & ":" & i).Insert Shift:=xlUp
End Sub

Nhưng khi OT muốn copy những dòng được lựa chọn thì OT viết như sau:

Mã:

Sub ThemDong()
    Dim i As Integer, r As Range
    For Each r In Selection
        i = r.Row
        Rows(i & ":" & i).Copy
        Rows(i & ":" & i).Insert Shift:=xlUp
    Next r
End Sub

Nếu chọn xen kẽ các ô thì không sao (A1,A3,A10,...), còn khi chọn liền nhau(A1,A3:A5) thì code nó lặp không nghỉ ạ.
Nhờ các bạn xử giúp vòng lặp ạ hic,

Maika8008 · 13/1/21

NHN_Phương đã viết:
Xin chào các bạn,
Khi OT muốn copy 1 dòng được lựa chọn, OT làm như sau:

Mã:

Sub ThemDong() Dim i As Integer i = Selection.Row Rows(i & ":" & i).Copy Rows(i & ":" & i).Insert Shift:=xlUp End Sub

Nhưng khi OT muốn copy những dòng được lựa chọn thì OT viết như sau:

Mã:

Sub ThemDong() Dim i As Integer, r As Range For Each r In Selection i = r.Row Rows(i & ":" & i).Copy Rows(i & ":" & i).Insert Shift:=xlUp Next r End Sub

Nếu chọn xen kẽ các ô thì không sao (A1,A3,A10,...), còn khi chọn liền nhau(A1,A3:A5) thì code nó lặp không nghỉ ạ.
Nhờ các bạn xử giúp vòng lặp ạ hic,

Bạn Insert dòng luôn trong phần chọn thì phần chọn cứ mở rộng ra mãi, vòng lặp sao ngừng được

Hoàng Nhật Phương · 13/1/21

Maika8008 đã viết:
Bạn Insert dòng luôn trong phần chọn thì phần chọn cứ mở rộng ra mãi, vòng lặp sao ngừng được

OT biết điều đó, nên mới nhờ giúp đỡ sửa lại vòng lặp bạn ah.
Bạn sửa giúp OT với.

befaint · 13/1/21

Luôn luôn và luôn luôn nhớ: xóa và thêm dòng/ cột thì quay mông xinh xinh đi lùi.

PHP:

Sub ThemDong()
    Dim i As Long, cell_ As Range
    Dim rng As Range, r As Long
    Set rng = Selection
    Dim a As Variant
    ReDim a(1 To rng.Cells.Count)
    For Each cell_ In rng
        i = i + 1
        a(i) = cell_.Row
    Next cell_
    For i = UBound(a) To 1 Step -1
        r = a(i)
        Rows(r & ":" & r).Copy
        Rows(r & ":" & r).Insert Shift:=xlUp
        Application.CutCopyMode = False
    Next i
End Sub

Hoàng Nhật Phương · 13/1/21

befaint đã viết:

Luôn luôn và luôn luôn nhớ: xóa và thêm dòng/ cột thì quay mông xinh xinh đi lùi.

PHP:

Sub ThemDong()
    Dim i As Long, cell_ As Range
    Dim rng As Range, r As Long
    Set rng = Selection
    Dim a As Variant
    ReDim a(1 To rng.Cells.Count)
    For Each cell_ In rng
        i = i + 1
        a(i) = cell_.Row
    Next cell_
    For i = UBound(a) To 1 Step -1
        r = a(i)
        Rows(r & ":" & r).Copy
        Rows(r & ":" & r).Insert Shift:=xlUp
        Application.CutCopyMode = False
    Next i
End Sub

Úi xời, nhìn tưởng đơn giản mà cũng phực tạp thật.
Đúng là phải đi lùi ạ

, ngoài sử dụng vòng lặp For ra có thể sử dụng Do với 1 vòng hay sử dụng Union gì đó được không Bạn?

befaint · 13/1/21

NHN_Phương đã viết:
1 vòng

Làm sao mà cứ 1 vòng với vòng 1 làm gì.
Code kia chữa cháy thôi, lý ra còn phải loại các dòng chọn trùng nữa.

Hoàng Nhật Phương · 13/1/21

befaint đã viết:
Làm sao mà cứ 1 vòng với vòng 1 làm gì.
Code kia chữa cháy thôi, lý ra còn phải loại các dòng chọn trùng nữa.

Hic, OT chưa biết gặp phải lỗi gì nhưng OT thử thấy 'ngon lành' mà Bạn.

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

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

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

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ạo cội

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ạo cội

Thành viên gắn bó

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

Thành viên gắn bó

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

Thành viên gắn bó

Đếm ngược thời gian