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

Liên hệ QC

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

Đang trực tuyến: 4 (Thành viên: 0, Khách: 4)
maytinhvp01

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:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Chào cả nhà, mình muốn xóa nhiều sheet và để lại 2 sheet thì phải code thế nào ạ?
 
Upvote 0
Duong.bach đã viết:
Chào cả nhà, mình muốn xóa nhiều sheet và để lại 2 sheet thì phải code thế nào ạ?
Nhấp chuột vào đây để mở rộng...
Const sheet_mot = "bach"
Cont sheet_hai = "tuyet"
Dim ws as worksheet, ws_name as string
For each ws in thisworkbook.worksheets
ws_name = ws.name
If ws_name <> sheet_mot and ws_name <> sheet_hai Then
ws.delete
End if
Next ws
Msgbox "Xong phim ba con heo con!"
 
Upvote 0
befaint đã viết:
Const sheet_mot = "bach"
Cont sheet_hai = "tuyet"
Dim ws as worksheet, ws_name as string
For each ws in thisworkbook.worksheets
ws_name = ws.name
If ws_name <> sheet_mot and ws_name <> sheet_hai Then
ws.delete
End if
Next ws
Msgbox "Xong phim ba con heo con!"
Nhấp chuột vào đây để mở rộng...
bach tuyet liên quan gì đến heo con. Tính quảng cáo phim con heo hở.
Code thiếu hàm LCase.
 
Upvote 0
VetMini đã viết:
bach tuyet liên quan gì đến heo con. Tính quảng cáo phim con heo hở.
Code thiếu hàm LCase.
Nhấp chuột vào đây để mở rộng...
Phim ba con heo con, không phải phim con heo đâu bác. :D

----
@ Bạch Nương Tử:

For each ws in thisworkbook.worksheets
If thisworkbook.worksheets.count=1 then exit for
ws_name = VBA.Lcase$(ws.name)
If ws_name <> sheet_mot and ws_name <> sheet_hai Then
ws.delete
End if
Next ws
 
Upvote 0
Em chào Anh Chị,
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Target = Sheet5.Range("A1").Value
    If Target = True Then Call AnDongCot
    Else
    Call HienDongCot
End If
End Sub
Em đang tạo đoạn code trên. Mục đích khi Em tích vào check bóc thì ô A1 là TRUE còn bỏ tích thì A1 là FALSE. Em muốn tạo sự kiện nếu ô A1 là TRUE thì chạy code Ẩn dòng cột, ngược lại chạy code hiện dòng cột. Hiện tại code chưa chạy được ạ. Em đang tập code mong A/C chỉ bảo. Em cảm ơn!
 
Upvote 0
Love GPE đã viết:
Em chào Anh Chị,
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Target = Sheet5.Range("A1").Value
    If Target = True Then Call AnDongCot
    Else
    Call HienDongCot
End If
End Sub
Em đang tạo đoạn code trên. Mục đích khi Em tích vào check bóc thì ô A1 là TRUE còn bỏ tích thì A1 là FALSE. Em muốn tạo sự kiện nếu ô A1 là TRUE thì chạy code Ẩn dòng cột, ngược lại chạy code hiện dòng cột. Hiện tại code chưa chạy được ạ. Em đang tập code mong A/C chỉ bảo. Em cảm ơn!
Nhấp chuột vào đây để mở rộng...
Target ở đây là đối tượng hay nói cách khác là ô mà bạn tác động tới.trường hợp này bạn lấy địa chỉ của target đi.Đại loại nó như vầy
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$A$1" Then Exit Sub
    If Target.Value = True Then
            Call AnDongCot
    Else
            Call HienDongCot
    End If
End Sub
 
Upvote 0
Love GPE đã viết:
Em chào Anh Chị,
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Target = Sheet5.Range("A1").Value
    If Target = True Then Call AnDongCot
    Else
    Call HienDongCot
End If
End Sub
Em đang tạo đoạn code trên. Mục đích khi Em tích vào check bóc thì ô A1 là TRUE còn bỏ tích thì A1 là FALSE. Em muốn tạo sự kiện nếu ô A1 là TRUE thì chạy code Ẩn dòng cột, ngược lại chạy code hiện dòng cột. Hiện tại code chưa chạy được ạ. Em đang tập code mong A/C chỉ bảo. Em cảm ơn!
Nhấp chuột vào đây để mở rộng...
Bạn viết thế này
If Target. Address = "$A$1" then
If Target.Value = TRUE Then
 
Upvote 0
Cu Tồ đã viết:
Target ở đây là đối tượng hay nói cách khác là ô mà bạn tác động tới.trường hợp này bạn lấy địa chỉ của target đi.Đại loại nó như vầy
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$A$1" Then Exit Sub
    If Target.Value = True Then
            Call AnDongCot
    Else
            Call HienDongCot
    End If
End Sub
Nhấp chuột vào đây để mở rộng...
Maika8008 đã viết:
Bạn viết thế này
If Target. Address = "$A$1" then
If Target.Value = TRUE Then
Nhấp chuột vào đây để mở rộng...

Cảm ơn Bạn Cu Tồ và Bạn Maika8008. Code của 2 Bạn mình chạy thử Ok rồi.
Mình muốn bổ sung thêm trường hợp dùng check box để lấy TRUE và FALSE vào ô A1 thì code sẽ chạy. Mong các Bạn xem giúp mình thêm cách để sử dụng được check box trong trường hợp này. Tks các Bạn!
1608273411409.png
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Love GPE đã viết:
Cảm ơn Bạn Cu Tồ và Bạn Maika8008. Code của 2 Bạn mình chạy thử Ok rồi.
Mình muốn bổ sung thêm trường hợp dùng check box để lấy TRUE và FALSE vào ô A1 thì code sẽ chạy. Mong các Bạn xem giúp mình thêm cách để sử dụng được check box trong trường hợp này. Tks các Bạn!
View attachment 251465
Nhấp chuột vào đây để mở rộng...
Vậy bạn đừng link cell nữa mà dùng sự kiện click của checkbox
Private Sub CheckBox1_Click() 'Sửa lại tên checkbox cho đúng
If CheckBox1.Value = True Then
Range("A1") = 1
Else
Range("A1") = 0
End If
End Sub

Ở sự kiện Change của Sheet thì:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
If Target.Text = "1" Then
Call AnDongCot
Else
Call HienDongCot
End If
End Sub
 
Upvote 0
Maika8008 đã viết:
Vậy bạn đừng link cell nữa mà dùng sự kiện click của checkbox
Private Sub CheckBox1_Click() 'Sửa lại tên checkbox cho đúng
If CheckBox1.Value = True Then
Range("A1") = 1
Else
Range("A1") = 0
End If
End Sub

Ở sự kiện Change của Sheet thì:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
If Target.Text = "1" Then
Call AnDongCot
Else
Call HienDongCot
End If
End Sub
Nhấp chuột vào đây để mở rộng...
Mình chạy code được rồi. Cảm ơn Bạn rất nhiều!
 
Upvote 0
Em chào Anh Chị,
Trong sự kiện Workbook_Open
Em đang để Sheet 2 được mở ra lúc mở file như code dưới đây.
Mã: 
Private Sub Workbook_Open()
    Sheet2.Select
End Sub

Em muốn chỗ Sheet2.Select có thể tùy biến tại ô H3 ở sheet1 (tức là ở sheet 1 ô H3 Em chọn sheet nào thì sau này khi mở file sheet đó sẽ được mở ra )
Em có sửa code như dưới đây. Nhưng chưa được.

Private Sub Workbook_Open()
Sheet1.Range("H3").Value.Select
End Sub

Mong Anh Chị xem giúp Em. Cảm ơn Anh Chị!
 
Upvote 0
Love GPE đã viết:
Em chào Anh Chị,
Trong sự kiện Workbook_Open
Em đang để Sheet 2 được mở ra lúc mở file như code dưới đây.
Mã: 
Private Sub Workbook_Open()
    Sheet2.Select
End Sub

Em muốn chỗ Sheet2.Select có thể tùy biến tại ô H3 ở sheet1 (tức là ở sheet 1 ô H3 Em chọn sheet nào thì sau này khi mở file sheet đó sẽ được mở ra )
Em có sửa code như này, Nhưng chưa được.

Private Sub Workbook_Open()
Sheet1.Range("H3").Value.Select
End Sub

Mong Anh Chị xem giúp Em. Cảm ơn Anh Chị!
Nhấp chuột vào đây để mở rộng...
Thử như sau nha bạn

Sheet1.Select
Range("H3").select
 
Upvote 0
Love GPE đã viết:
Em chào Anh Chị,
Trong sự kiện Workbook_Open
Em đang để Sheet 2 được mở ra lúc mở file như code dưới đây.
Mã: 
Private Sub Workbook_Open()
    Sheet2.Select
End Sub

Em muốn chỗ Sheet2.Select có thể tùy biến tại ô H3 ở sheet1 (tức là ở sheet 1 ô H3 Em chọn sheet nào thì sau này khi mở file sheet đó sẽ được mở ra )
Em có sửa code như dưới đây. Nhưng chưa được.

Private Sub Workbook_Open()
Sheet1.Range("H3").Value.Select
End Sub

Mong Anh Chị xem giúp Em. Cảm ơn Anh Chị!
Nhấp chuột vào đây để mở rộng...
Gán cho nó bằng một biến ví dụ S= sheet1.range("h3").Value
sau đó là sheets(s).select
Bài đã được tự động gộp:

Cụ thể là vầy
Mã: 
Dim S As String
    S = Sheet1.Range("H3").Value
Sheets(S).Select
hoặc chơi thẳng vầy
Mã: 
Sheets(Sheet1.Range("H3").Value).Select
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Thử như sau nha bạn

Sheet1.Select
Range("H3").select
Nhấp chuột vào đây để mở rộng...
Anh ơi Em chạy code thì nó vẫn đứng im ở sheet 1 Anh ạ. Anh xem giúp Em với nhé. Cảm ơn Anh!

1608283980326.png
Bài đã được tự động gộp:

Cu Tồ đã viết:
Gán cho nó bằng một biến ví dụ S= sheet1.range("h3").Value
sau đó là sheets(s).select
Bài đã được tự động gộp:

Cụ thể là vầy
Mã: 
Dim S As String
    S = Sheet1.Range("H3").Value
Sheets(S).Select
hoặc chơi thẳng vầy
Mã: 
Sheets(Sheet1.Range("H3").Value).Select
Nhấp chuột vào đây để mở rộng...
Mình chạy code đã được rồi. Cảm ơn Bạn Cu Tồ nhiều!
 
Upvote 0
Em chào anh/chị. Anh chị có thể cho em code của lệnh chuyển đổi file exel sang file PDF không ạ. Em mong muốn khi click vào hình có chữ Chuyển đổi PDF trong file thì sẽ thực hiện việc chuyển đổi tự động và lấy tên file ở Cell tô màu vàng. Em cảm ơn anh chị
 

File đính kèm

Upvote 0
Phamanh1998 đã viết:
Em chào anh/chị. Anh chị có thể cho em code của lệnh chuyển đổi file exel sang file PDF không ạ. Em mong muốn khi click vào hình có chữ Chuyển đổi PDF trong file thì sẽ thực hiện việc chuyển đổi tự động và lấy tên file ở Cell tô màu vàng. Em cảm ơn anh chị
Nhấp chuột vào đây để mở rộng...
Dùng đoạn code sau:
Mã: 
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ThisWorkbook.Path & "\" & ThisWorkbook.ActiveSheet.Name & ".pdf", _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, OpenAfterPublish:=False
 

File đính kèm

Upvote 0
leonguyenz đã viết:
Dùng đoạn code sau:
Mã: 
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ThisWorkbook.Path & "\" & ThisWorkbook.ActiveSheet.Name & ".pdf", _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, OpenAfterPublish:=False
Nhấp chuột vào đây để mở rộng...
Anh cho em xin phép hỏi thêm là có cách nào lấy tên file PDF theo tên mình mong muốn không ạ chứ kg lấy tên file theo tên Sheet. Như trong file này em muốn file PDF được trích ra nhưng lấy tên theo Cell F1 em bôi vàng. Nếu được mong anh giúp đỡ em cảm ơn anh
 
Upvote 0
Phamanh1998 đã viết:
Anh cho em xin phép hỏi thêm là có cách nào lấy tên file PDF theo tên mình mong muốn không ạ chứ kg lấy tên file theo tên Sheet. Như trong file này em muốn file PDF được trích ra nhưng lấy tên theo Cell F1 em bôi vàng. Nếu được mong anh giúp đỡ em cảm ơn anh
Nhấp chuột vào đây để mở rộng...
Sửa chổ
Mã: 
ThisWorkbook.ActiveSheet.Name
thành
Mã: 
ThisWorkbook.ActiveSheet.[F1]
 
Upvote 0
Em chào anh chị, anh chị cho em hỏi Code VBA để tự động chuyển file exel sang PDF theo như tên mong muốn và lựa chọn được chỗ lưu file PDF theo ý muốn được không ạ, Code trong file em hỏi ở trên thì chỉ lưu được tên theo ý muốn còn vị trí lưu thì lưu cùng với file Exel. Em mong anh chị giúp đỡ ạ, em chân thành cảm ơn.
 

File đính kèm

Upvote 0
Phamanh1998 đã viết:
Em chào anh chị, anh chị cho em hỏi Code VBA để tự động chuyển file exel sang PDF theo như tên mong muốn và lựa chọn được chỗ lưu file PDF theo ý muốn được không ạ, Code trong file em hỏi ở trên thì chỉ lưu được tên theo ý muốn còn vị trí lưu thì lưu cùng với file Exel. Em mong anh chị giúp đỡ ạ, em chân thành cảm ơn.
Nhấp chuột vào đây để mở rộng...
Bạn xem trong code, sửa chỗ thisworkbook.path thành đường dẫn cụ thể đến nơi bạn muốn.
 
Upvote 0
Maika8008 đã viết:
Bạn xem trong code, sửa chỗ thisworkbook.path thành đường dẫn cụ thể đến nơi bạn muốn.
Nhấp chuột vào đây để mở rộng...
Em thử sửa như sau mà báo lỗi,Anh có thể sửa mẫu cho em được không ạ vì em không biết về chỉnh sửa code VBA ạ. . Em cảm ơn anh
1609330619886.png
 
Lần chỉnh sửa cuối:
Upvote 0
Em chào anh/chị.
Em hiện nay có cái phiếu ghi nhận năng suất như theo file đính kèm. Em muốn hỏi anh chị cho em xin Code VBA để tự ẩn những dòng không có dữ liệu ạ. Em cảm ơn anh chị
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Phamanh1998 đã viết:
Em chào anh/chị.
Em hiện nay có cái phiếu ghi nhận năng suất như theo file đính kèm. Em muốn hỏi anh chị cho em xin Code VBA để tự ẩn những dòng không có dữ liệu ạ. Em cảm ơn anh chị
Nhấp chuột vào đây để mở rộng...
Sao công chúa không đăng chủ đề mới. Đây là thắc mắc về code, mà công chúa chưa có gì để théc méc.
 
Upvote 0
Xin chào các chuyên gia, mình xin được hỗ trợ về code VBA thay thế SUMIFS để điền công thức SUM khi thỏa mãn 2 điều kiện. Mô tả chi tiết trong file đình kèm.
 

File đính kèm

Upvote 0
DaiKaPeter đã viết:
Xin chào các chuyên gia, mình xin được hỗ trợ về code VBA thay thế SUMIFS để điền công thức SUM khi thỏa mãn 2 điều kiện. Mô tả chi tiết trong file đình kèm.
Nhấp chuột vào đây để mở rộng...
Bạn đăng chủ đề mới đi! Tại bài #2875 đã có khuyến cáo rồi đấy.
 
Upvote 0
Xin chào tất cả các Bạn, OT có sưu tầm một đoạn code sau để mở tất cả các file theo ý:
docs.microsoft.com

FileDialog.SelectedItems property (Office)

Office VBA reference topic
docs.microsoft.com
Mã: 
Option Explicit

Sub Main()
 
 'Declare a variable as a FileDialog object.
 Dim fd As FileDialog
 
 'Create a FileDialog object as a File Picker dialog box.
 Set fd = Application.FileDialog(msoFileDialogFilePicker)
 
 'Declare a variable to contain the path
 'of each selected item. Even though the path is aString,
 'the variable must be a Variant because For Each...Next
 'routines only work with Variants and Objects.
 Dim vrtSelectedItem As Variant
 
 'Use a With...End With block to reference the FileDialog object.
 With fd
 
 'Allow the selection of multiple file.
 .AllowMultiSelect = True
 
 'Use the Show method to display the File Picker dialog box and return the user's action.
 'The user pressed the button.
 If .Show = -1 Then
 
 'Step through each string in the FileDialogSelectedItems collection
 For Each vrtSelectedItem In .SelectedItems
 
 'vrtSelectedItem is aString that contains the path of each selected item.
 'You can use any file I/O functions that you want to work with this path.
 'This example displays the path in a message box.
 MsgBox "Selected item's path: " & vrtSelectedItem
 
 Next vrtSelectedItem
 'The user pressed Cancel.
 Else
 End If
 End With
 
 'Set the object variable to Nothing.
 Set fd = Nothing
 
End Sub

Giờ với đoạn code trên OT muốn sửa không phải mở cửa sổ để lựa chọn các file muốn nữa mà thay vì thế thì sẽ liệt kê tên các file đó trong các ô tại bảng tính ví dụ A1:A10 của sheet1 thì code trên phải sửa lại thế nào ạ?
 
Upvote 0
Upvote 0
befaint đã viết:
Đó là chọn, chứ đã mở đâu.


Tên có gồm cái đuôi xinh xinh kèm theo không?
Ví dụ: hổ_báo.đuôi_xinh_xinh thì lấy hổ_báo thôi hay hổ_báo.đuôi_xinh_xinh
Nhấp chuột vào đây để mở rộng...

Đúng rồi @befaint ạ, đó là đã chọn ạ xin lỗi .
Đuôi xinh đó dạng like "*.xls*" ạ, hoặc có thể một dạng đuôi xinh khác ạ.
Nhờ Bạn giúp đỡ OT, cảm ơn Bạn nhiều befaint .
 
Upvote 0
NHN_Phương đã viết:
Giờ với đoạn code trên OT muốn sửa không phải mở cửa sổ để lựa chọn các file muốn nữa mà thay vì thế thì sẽ liệt kê tên các file đó trong các ô tại bảng tính ví dụ A1:A10 của sheet1 thì code trên phải sửa lại thế nào ạ?
Nhấp chuột vào đây để mở rộng...
Trời, đến giờ mà bạn còn hỏi cái sơ đẳng ...

Hiện thời code hiển thị tên các tập tin được chọn trong MsgBox (không phải mở cửa sổ để lựa chọn các file thì làm gì có chúng để mà hiển thị hay không). Bây giờ bạn không muốn MsgBox mà liệt kê các tên trong cột A?
1.
Mã: 
Dim filename As String

2. Thay
Mã: 
MsgBox "Selected item's path: " & vrtSelectedItem

bằng
Mã: 
filename = vrtSelectedItem     ' toàn bộ đường dẫn
filename = Mid(filename, InStrRev(filename, "\") + 1)     ' chỉ tên tập tin
ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = filename

Cái ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp) và Offset bạn đã từng đọc, từng viết không biết bao nhiêu lần rồi.
 
Upvote 0
batman1 đã viết:
Trời, đến giờ mà bạn còn hỏi cái sơ đẳng ...

Hiện thời code hiển thị tên các tập tin được chọn trong MsgBox (không phải mở cửa sổ để lựa chọn các file thì làm gì có chúng để mà hiển thị hay không). Bây giờ bạn không muốn MsgBox mà liệt kê các tên trong cột A?
1.
Mã: 
Dim filename As String

2. Thay
Mã: 
MsgBox "Selected item's path: " & vrtSelectedItem

bằng
Mã: 
filename = vrtSelectedItem     ' toàn bộ đường dẫn
filename = Mid(filename, InStrRev(filename, "\") + 1)     ' chỉ tên tập tin
ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = filename

Cái ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp) và Offset bạn đã từng đọc, từng viết không biết bao nhiêu lần rồi.
Nhấp chuột vào đây để mở rộng...
Dạ con chào Bác,
Vâng đúng là con rất ít để ý đến vấn đề này, giờ con mới tìm hiểu kỹ hơn để xử lý ạ.
Ý con thế này Bác., trong vùng A1:A10 con đã nhập sẵn tên các file ví dụ: A1="A.xls";A2="B.xlsx",A3="B.xlsm"... đến A10.
Các tên file được liệt kê này để chung với thư mục cùng file chứa code này ạ.
Giờ con muốn đoạn code mà tương tự đoạn code con đưa lên nhưng nó không hiển thị cái cửa sổ để chọn file nữa (thay vì bước này nó chọn các file mà đã liệt kê trong vùng A1:A10 rồi Bác ạ.
Sau khi lựa chọn các file đó xong nó mở hay ghi tên file đã được lựa chọn đó ra cửa sổ Immediate gì đó cũng được ạ.
------
Ngoài ra Bác cho con hỏi thêm với có cái nào hơn 'FileDialog" không ạ,như là hơn về tốc độ, hoặc hơn về mở được mọi đường dẫn (có dấu hoặc các thứ tiếng ạ ...
Con cảm ơn Bác đã giúp đỡ con.
 
Upvote 0
NHN_Phương đã viết:
Dạ con chào Bác,
Vâng đúng là con rất ít để ý đến vấn đề này, giờ con mới tìm hiểu kỹ hơn để xử lý ạ.
Ý con thế này Bác., trong vùng A1:A10 con đã nhập sẵn tên các file ví dụ: A1="A.xls";A2="B.xlsx",A3="B.xlsm"... đến A10.
Các tên file được liệt kê này để chung với thư mục cùng file chứa code này ạ.
Giờ con muốn đoạn code mà tương tự đoạn code con đưa lên nhưng nó không hiển thị cái cửa sổ để chọn file nữa (thay vì bước này nó chọn các file mà đã liệt kê trong vùng A1:A10 rồi Bác ạ.
Sau khi lựa chọn các file đó xong nó mở hay ghi tên file đã được lựa chọn đó ra cửa sổ Immediate gì đó cũng được ạ.
------
Ngoài ra Bác cho con hỏi thêm với có cái nào hơn 'FileDialog" không ạ,như là hơn về tốc độ, hoặc hơn về mở được mọi đường dẫn (có dấu hoặc các thứ tiếng ạ ...
Con cảm ơn Bác đã giúp đỡ
Nhấp chuột vào đây để mở rộng...
Bạn dùng đoạn code này, nó cũng hiện msgbox từng file như trên và tôi nghĩ bạn có thể dễ dàng tùy biến để dùng:

Rich (BB code): 
Sub SelectFilesInRange()
Dim Rg As Range, Cll As Range, MyPath As String, X
MyPath = ThisWorkbook.Path & "\"

On Error Resume Next
Set Rg = Application.InputBox("Quét 1 vùng", "Vùng quét", Type:=8)
If Err.Number = 424 Then
  MsgBox "Loi: chua chon vung!"
  Exit Sub
Else
   For Each Cll In Rg
       MsgBox MyPath & Cll.Value
   Next
End If
End Sub
 
Upvote 0
Maika8008 đã viết:
Bạn dùng đoạn code này, nó cũng hiện msgbox từng file như trên và tôi nghĩ bạn có thể dễ dàng tùy biến để dùng:

Rich (BB code): 
Sub SelectFilesInRange()
Dim Rg As Range, Cll As Range, MyPath As String, X
MyPath = ThisWorkbook.Path & "\"

On Error Resume Next
Set Rg = Application.InputBox("Quét 1 vùng", "Vùng quét", Type:=8)
If Err.Number = 424 Then
  MsgBox "Loi: chua chon vung!"
  Exit Sub
Else
   For Each Cll In Rg
       MsgBox MyPath & Cll.Value
   Next
End If
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn Banh, cái này thì OT biết nhưng OT muốn sử dụng cái kia để mở từng file rồi xử lý ạ.
 
Upvote 0
Upvote 0
NHN_Phương đã viết:
trong vùng A1:A10 con đã nhập sẵn tên các file ví dụ: A1="A.xls";A2="B.xlsx",A3="B.xlsm"... đến A10.
Các tên file được liệt kê này để chung với thư mục cùng file chứa code này ạ.
Giờ con muốn đoạn code mà tương tự đoạn code con đưa lên nhưng nó không hiển thị cái cửa sổ để chọn file nữa (thay vì bước này nó chọn các file mà đã liệt kê trong vùng A1:A10 rồi
Nhấp chuột vào đây để mở rộng...
Đọ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.
 
Upvote 0
Mọi code bạn cũng từng biết, từng dù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 dòng cuoi
    End With
    For r = 1 To UBound(filename, 1) - 1    ' không xét dò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 đủ thì If Not IsEmpty(filename(r, 1)) Then Debug.Print ThisWorkbook.Path & "\" & filename(r, 1)
-------------
Có thể dùng GetOpenFilename. Hoặc Windows API, nhưng bạ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
 
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
Dạ, OT xin gửi mô tả bằng hình ảnh để Bạn @befaint hiểu thêm ạ.

OT.jpg
Bài đã được tự động gộp:

batman1 đã viết:
Mọi code bạn cũng từng biết, từng dù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 dòng cuoi
    End With
    For r = 1 To UBound(filename, 1) - 1    ' không xét dò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 đủ thì If Not IsEmpty(filename(r, 1)) Then Debug.Print ThisWorkbook.Path & "\" & filename(r, 1)
-------------
Có thể dùng GetOpenFilename. Hoặc Windows API, nhưng bạ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
Nhấp chuột vào đây để mở rộng...
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.

1610381527749.png
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
NHN_Phương đã viết:
Dạ, OT xin gửi mô tả bằng hình ảnh để Bạn @befaint hiểu thêm ạ.
Nhấp chuột vào đây để mở rộng...
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:

1610384773108.png


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

1610384739531.png

Đã 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ì.
 
Upvote 0
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ì.
Nhấp chuột vào đây để mở rộng...
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 ạ)
 
Upvote 0
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
Nhấp chuột vào đây để mở rộ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
 
Upvote 0
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ì.
Nhấp chuột vào đây để mở rộng...
à 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:

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
Nhấp chuột vào đây để mở rộng...
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
 
Lần chỉnh sửa cuối:
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...

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 ạ
Nhấp chuột vào đây để mở rộng...
Tôi không hiểu bạn nói gì nữa. Theo bạn giải thích vòng vo thì bây giờ bạn muốn dùng FileDialog nhưng bỏ cửa số chọn tập tin và bỏ đoạn If .Show = -1 Then ... End If vì tên các tập tin lấy từ cột A. Trời ạ, FileDialog chỉ dùng với mục đích lấy tên các tập tin được chọn. Nếu không chọn nữa mà lấy các tên từ cột A thì đá đít thằng FileDialog chứ sao lại "dùng FileDialog nhưng bỏ If .Show = -1 Then ... End If"? Đã không phải chọn thì muôn đời không dùng FileDialog, bạn có hiểu điều đơn giản ấy không?

chiến luôn ở bài #2889 là hiển thị ở cửa sổ Immediate vì bạn viết ở bài #2884
mở hay ghi tên file đã được lựa chọn đó ra cửa sổ Immediate
Nhấp chuột vào đây để mở rộng...

Còn nếu muốn kiểm tra tồn tại rồi mở trong Excel thì
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) - tạo đối tượng fso lớp (class) FileSystemObject để sau đó dùng phương thức FileExists của nó kiểm tra sự tồn tại của tập tin bất kỳ (không chỉ tập tin Excel - tập tin bất kỳ)
 
Upvote 0
batman1 đã viết:
. Tời ạ, FileDialog chỉ dùng với mục đích lấy tên các tập tin được chọn. Nếu không chọn nữa mà lấy các tên từ cột A thì đá đít thằng FileDialog chứ sao lại "dùng FileDialog nhưng bỏ If .Show = -1 Then ... End If"? Đã không phải chọn thì muôn đời không dùng FileDialog, bạn có hiểu điều đơn giản ấy không?
Nhấp chuột vào đây để mở rộ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 ở bài #2889 là hiển thị ở cửa sổ Immediate vì bạn viết ở bài #2884
Còn nếu muốn kiểm tra tồn tại rồi mở trong Excel thì
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
Nhấp chuột vào đây để mở rộng...
Đúng cái con cần rồi Bác, con cảm ơn Bác Siwtom, cảm ơn Bạn @befaint
 
Upvote 0
batman1 đã viết:
Tôi không hiểu bạn nói gì nữa. Theo bạn giải thích vòng vo thì bây giờ bạn muốn dùng FileDialog nhưng bỏ cửa số chọn tập tin và bỏ đoạn If .Show = -1 Then ... End If vì tên các tập tin lấy từ cột A. Trời ạ, FileDialog chỉ dùng với mục đích lấy tên các tập tin được chọn. Nếu không chọn nữa mà lấy các tên từ cột A thì đá đít thằng FileDialog chứ sao lại "dùng FileDialog nhưng bỏ If .Show = -1 Then ... End If"? Đã không phải chọn thì muôn đời không dùng FileDialog, bạn có hiểu điều đơn giản ấy không?

chiến luôn ở bài #2889 là hiển thị ở cửa sổ Immediate vì bạn viết ở bài #2884


Còn nếu muốn kiểm tra tồn tại rồi mở trong Excel thì
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) - tạo đối tượng fso lớp (class) FileSystemObject để sau đó dùng phương thức FileExists của nó kiểm tra sự tồn tại của tập tin bất kỳ (không chỉ tập tin Excel - tập tin bất kỳ)
Nhấp chuột vào đây để mở rộng...
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 ạ ?
 
Upvote 0
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)
Nhấp chuột vào đây để mở rộng...
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 ?
 
Lần chỉnh sửa cuối:
Upvote 0
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 ?
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
NHN_Phương đã viết:
Function OpenOtherFile(sFile As String)
Dim sApp As Object
Set sApp = CreateObject("Shell.Application")
sApp.Open (sFile)
End Function
Nhấp chuột vào đây để mở rộng...
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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,
 
Upvote 0
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,
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
Ú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 ạ :D, 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?
 
Upvote 0
befaint đã viết:
Có gì đâu mà không đơn giản.
Khúc lấy địa chỉ dòng thì thêm loại trùng vào là xong thôi.
Nhấp chuột vào đây để mở rộng...
OT thấy khó là vì có thể chỗ thì chọn một cột còn chỗ thì quét nhiều cột, không đồng nhất về số cột của mỗi vùng được lựa chọn ấy Bạn.
 
Upvote 0
befaint đã viết:
Chiêu này gọi là chiêu thiên nga múa đó hả.

Chép cho dẻo tay nhé.

View attachment 252927
Nhấp chuột vào đây để mở rộng...

'Đại ca' ơi xem giúp 'em' lỗi này là lỗi gì vớii ạ:fish:

1610544847310.png
Mã: 
Option Explicit

Sub ThemDong()
    Dim i As Long, r As Long, a As Variant
    Dim cell_ As Range, rng As Range
    If TypeName(Selection) <> "Range" Then Exit Sub
    Set rng = Selection
    Dim oArrList As Object
    Set oArrList = CreateObject("System.Collections.ArrayList")
    For Each cell_ In rng
        r = cell_.Row
        If oArrList.Contains(r) = False Then
            oArrList.Add r
        End If
    Next cell_
    If oArrList.Count = 0 Then Exit Sub
    oArrList.Sort
    a = oArrList.ToArray
    For i = UBound(a) To LBound(a) Step -1
        r = a(i)
        Rows(r & ":" & r).Copy
        Rows(r & ":" & r).Insert Shift:=xlUp
        Application.CutCopyMode = False
    Next i
    Set oArrList = Nothing: Erase a: Set rng = Nothing
End Sub
 
Upvote 0
A! Được rồi, tuyệt vời cảm ơn Bạn @befaint ,
thì ra 'System.Collections.ArrayList' nó không thích hợp với 'NET 4.0' mà thích hợp với 'NET 3.5'

stackoverflow.com

automation error -2146232576 (80131700) on creating an array

I have a macro that's working on one computer just fine, however when I try to run it on another computer I get the following error: Run-time error '-2146232576 (80131700)' Automation error Here'...
stackoverflow.com stackoverflow.com

Ơ nhưng mà nếu vậy thì code này nếu chuyển sang máy tính khác đang mặc định 'NET 4.0' thì sẽ không chạy được nếu không cài 'NET 3.5' ạ?
 
Upvote 0
ptm0412 đã viết:
Thì xài Dictionary đi
Nhấp chuột vào đây để mở rộng...
Chú Mỹ nay có hứng thú không ạ, chú chỉ giúp con cái xài 'Dictionary' 'cho chiêu thiên nga múa với vùng chọn này với chú Mỹ :
Mã: 
Range("B3:D4,C6:J7,A9:E12").Select
Con thấy code của bạn @befaint xử lý được chiêu này rồi ạ.
 

File đính kèm

Upvote 0
ptm0412 đã viết:
Học befaint còn chưa hết chiêu mà tham lam. Thế đã nhớ vụ "quay mông xinh xinh đi lùi" chưa?
Nhấp chuột vào đây để mở rộng...
Vụ này chiều nay con cười xái cả quai hàm nên quên sao dễ được ạ. --=0
Hôm nay con còn biết thêm được nữa là code cần phải 'tét trong phòng thí nghiệm' nữa ahihi nẫu hết cả ruột.
Ai bảo chú gợi ý, mà khi đã còn cách là con sẽ phải cố xem cách nào nó tiện nhất vì không chỉ làm cho mỗi bản thân mình dùng mà còn cho người khác dùng để không làm phiền người khác, người khác cũng không gọi đến mình thì con chọn ạ.
 
Upvote 0
NHN_Phương đã viết:
Ai bảo chú gợi ý, mà khi đã còn cách là con sẽ phải cố xem cách nào nó tiện nhất
Nhấp chuột vào đây để mở rộng...
Dictionary thua Collections.ArrayList vì ArrayList có phương thức sort, do đó Dict. phải chạy đường vòng và chậm hơn. Không hứng mấy nên chưa tối ưu
PHP: 
Sub CopyInsertSelection()
Dim Dict, Arr()
Dim Cll As Range, i As Long, k As Long, lastRw As Long
Application.ScreenUpdating = False
lastRw = Cells(10000, 3).End(xlUp).Row
Set Dict = CreateObject("Scripting.Dictionary")
ReDim Arr(1 To lastRw, 1 To 1)
For Each Cll In Selection
    If Not Dict.exists(Cll.Row) Then
        Dict.Add Cll.Row, ""
        Arr(Cll.Row, 1) = Cll.Row
    End If
Next
For i = lastRw To 1 Step -1
    If Arr(i, 1) > 0 Then
        k = Arr(i, 1)
        Cells(k, 1).EntireRow.Copy
        Cells(k, 1).Insert Shift:=xlDown
    End If
Next
Set Dict = Nothing: Set Cll = Nothing: Erase Arr
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
 
Upvote 0
ptm0412 đã viết:
Dictionary thua Collections.ArrayList vì ArrayList có phương thức sort, do đó Dict. phải chạy đường vòng và chậm hơn. Không hứng mấy nên chưa tối ưu
PHP: 
Sub CopyInsertSelection()
Dim Dict, Arr()
Dim Cll As Range, i As Long, k As Long, lastRw As Long
Application.ScreenUpdating = False
lastRw = Cells(10000, 3).End(xlUp).Row
Set Dict = CreateObject("Scripting.Dictionary")
ReDim Arr(1 To lastRw, 1 To 1)
For Each Cll In Selection
    If Not Dict.exists(Cll.Row) Then
        Dict.Add Cll.Row, ""
        Arr(Cll.Row, 1) = Cll.Row
    End If
Next
For i = lastRw To 1 Step -1
    If Arr(i, 1) > 0 Then
        k = Arr(i, 1)
        Cells(k, 1).EntireRow.Copy
        Cells(k, 1).Insert Shift:=xlDown
    End If
Next
Set Dict = Nothing: Set Cll = Nothing: Erase Arr
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Ơ, con mang code vào phòng thí nghiệm để tét với chiêu thiên nga múa các kiểu, kết quả tuyệt vời không kém gì phương pháp của Bạn @befaint chú Mỹ ơi .
Không có cảm giác chậm lắm chú Mỹ,thay vì phải xử lý từng dòng trên bảng tính thì kết hợp với Union gàn hết vào một thể xong rồi xử lý một lần được không chú Mỹ nhỉ?
 
Upvote 0
NHN_Phương đã viết:
Ơ, con mang code vào phòng thí nghiệm để tét với chiêu thiên nga múa các kiểu, kết quả tuyệt vời không kém gì phương pháp của Bạn @befaint chú Mỹ ơi .
Không có cảm giác chậm lắm chú Mỹ,thay vì phải xử lý từng dòng trên bảng tính thì kết hợp với Union gàn hết vào một thể xong rồi xử lý một lần được không chú Mỹ nhỉ?
Nhấp chuột vào đây để mở rộng...
Không union được, Còn phương pháp thì giống y của bi phèn nhá! Chỉ khác công cụ và thủ thuật thôi nhá!
Trường hợp chậm là khi dữ liệu rất nhiều nhưng chỉ insert 1 số ít năm ba dòng
 
Upvote 0
ptm0412 đã viết:
Không union được
Nhấp chuột vào đây để mở rộng...
Dạ vâng, vậy thôi chú Mỹ con chỉ mong chờ thêm xem nếu sử dụng được Union thì sẽ thế nào thôi ạ. Còn với cách nào nữa thì thôi ạ.. cách của chú Mỹ và của Bạn @befaint quá ổn rồi ạ.
Dạ thôi con xin phép đây, chú Mỹ tiếp tục múa đi nha :D, con ngủ đây ạ,chúc chú Mỹ ngủ ngon.
 
Upvote 0
NHN_Phương đã viết:
Dạ vâng, vậy thôi chú Mỹ con chỉ mong chờ thêm xem nếu sử dụng được Union thì sẽ thế nào thôi ạ. Còn với cách nào nữa thì thôi ạ.. cách của chú Mỹ và của Bạn @befaint quá ổn rồi ạ.
Dạ thôi con xin phép đây, chú Mỹ tiếp tục múa đi nha :D, con ngủ đây ạ,chúc chú Mỹ ngủ ngon.
Nhấp chuột vào đây để mở rộng...
Dùng mảng lưu thứ tự dòng, tự thêm lệnh tăng tốc code ( application. )
Mã: 
Sub ThemDong_ABC()
    
  Range("B3:D4,C6:J7,A9:E12").Select 'Test
  If TypeName(Selection) <> "Range" Then Exit Sub
 
  Dim fRow&, eRow&, i&
  Dim iRow As Range, Rng As Range, aRow() As Boolean
    
  Set Rng = Selection
  fRow = Rows.Count: eRow = 10 'Tuy hi?: 10>0
  ReDim aRow(1 To eRow)
  For Each iRow In Rng.Rows
    i = iRow.Row
    If i > eRow Then
      eRow = i
      If eRow > UBound(aRow) Then ReDim Preserve aRow(1 To eRow + 100) 'Tuy hi?: 100>=0
    End If
    If i < fRow Then fRow = i
    aRow(i) = True
  Next iRow
  For i = eRow To fRow Step -1
    If aRow(i) Then
      Rows(i & ":" & i).Insert Shift:=xlUp
      Rows(i + 1 & ":" & i + 1).Copy Rows(i & ":" & i)
    End If
  Next i
  Range("A" & i + 1).Select
  Erase aRow: Set Rng = Nothing: Set RngEx = Nothing: Set iRow = Nothing
End Sub
 
Upvote 0
HieuCD đã viết:
Dùng mảng lưu thứ tự dòng, tự thêm lệnh tăng tốc code ( application. )
Mã: 
Sub ThemDong_ABC()
   
  Range("B3:D4,C6:J7,A9:E12").Select 'Test
  If TypeName(Selection) <> "Range" Then Exit Sub

  Dim fRow&, eRow&, i&
  Dim iRow As Range, Rng As Range, aRow() As Boolean
   
  Set Rng = Selection
  fRow = Rows.Count: eRow = 10 'Tuy hi?: 10>0
  ReDim aRow(1 To eRow)
  For Each iRow In Rng.Rows
    i = iRow.Row
    If i > eRow Then
      eRow = i
      If eRow > UBound(aRow) Then ReDim Preserve aRow(1 To eRow + 100) 'Tuy hi?: 100>=0
    End If
    If i < fRow Then fRow = i
    aRow(i) = True
  Next iRow
  For i = eRow To fRow Step -1
    If aRow(i) Then
      Rows(i & ":" & i).Insert Shift:=xlUp
      Rows(i + 1 & ":" & i + 1).Copy Rows(i & ":" & i)
    End If
  Next i
  Range("A" & i + 1).Select
  Erase aRow: Set Rng = Nothing: Set RngEx = Nothing: Set iRow = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Hay quá Bác ơi, bắt đầu con thấy trong con đã xuất hiện 'ReDim Preserve' ahihi.
Con cảm ơn Bác @HieuCD
 
Upvote 0
chào các anh chị. Em có file dữ liệu mà hiện tại có dòng lệnh này em vẫn chưa hiểu. Mong các anh chị giúp đỡ. Em là newbie. Đang tìm hiểu nên có gì anh chị chỉ dẫn giúp em nhé. Em cảm ơn ạ.
Sub InsertBottomRow(AccountFrame)
Set ARange = Range(AccountFrame)
Application.ScreenUpdating = False
ActiveSheet.Unprotect
CntRow = ARange.Rows.Count - 3
ARange.Rows(CntRow).EntireRow.Insert
ARange.Columns(1).Rows(CntRow).Activate
Range("AccountRow").Copy Destination:=ActiveCell
ActiveCell.Offset(0, 2).Value = Range(AccountFrame).Columns(1).Rows(1).Value
ActiveCell.Activate
ActiveSheet.Protect
Application.ScreenUpdating = True
End Sub


Sub InsertRowAtSelection(AccountFrame)
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Set ARange = Range(AccountFrame)
CntRow = ARange.Rows.Count - 3

Set SRange = Range(Range(AccountFrame).Columns(1).Rows(3), Range(AccountFrame).Columns(15).Rows(CntRow))

If (Intersect(ActiveCell, SRange) Is Nothing) Then
MsgBox "Select a white cell within an account.", 0, "Wrong cell!"
Exit Sub
End If

Range("B" & (ActiveCell.Row)).Select
Selection.EntireRow.Insert
Range("AccountRow").Copy Destination:=ActiveCell
ActiveCell.Offset(0, 2).Value = Range(AccountFrame).Columns(1).Rows(1).Value
ActiveCell.Activate
ActiveSheet.Protect
Application.ScreenUpdating = True
End Sub

cái này dùng để thêm dòng vào một khoảng có trước mà em vẫn không làm được.
 
Upvote 0
tototolon_123 đã viết:
chào các anh chị. Em có file dữ liệu mà hiện tại có dòng lệnh này em vẫn chưa hiểu. Mong các anh chị giúp đỡ. Em là newbie. Đang tìm hiểu nên có gì anh chị chỉ dẫn giúp em nhé. Em cảm ơn ạ.
Sub InsertBottomRow(AccountFrame)
Set ARange = Range(AccountFrame)
Application.ScreenUpdating = False
ActiveSheet.Unprotect
CntRow = ARange.Rows.Count - 3
ARange.Rows(CntRow).EntireRow.Insert
ARange.Columns(1).Rows(CntRow).Activate
Range("AccountRow").Copy Destination:=ActiveCell
ActiveCell.Offset(0, 2).Value = Range(AccountFrame).Columns(1).Rows(1).Value
ActiveCell.Activate
ActiveSheet.Protect
Application.ScreenUpdating = True
End Sub


Sub InsertRowAtSelection(AccountFrame)
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Set ARange = Range(AccountFrame)
CntRow = ARange.Rows.Count - 3

Set SRange = Range(Range(AccountFrame).Columns(1).Rows(3), Range(AccountFrame).Columns(15).Rows(CntRow))

If (Intersect(ActiveCell, SRange) Is Nothing) Then
MsgBox "Select a white cell within an account.", 0, "Wrong cell!"
Exit Sub
End If

Range("B" & (ActiveCell.Row)).Select
Selection.EntireRow.Insert
Range("AccountRow").Copy Destination:=ActiveCell
ActiveCell.Offset(0, 2).Value = Range(AccountFrame).Columns(1).Rows(1).Value
ActiveCell.Activate
ActiveSheet.Protect
Application.ScreenUpdating = True
End Sub

cái này dùng để thêm dòng vào một khoảng có trước mà em vẫn không làm được.
Nhấp chuột vào đây để mở rộng...
Dòng nào không hiểu? "có dòng lệnh này em vẫn chưa hiểu" trong khi đưa cả tập lệnh mà không chỉ dòng nào là sao?
 
Upvote 0
Maika8008 đã viết:
Dòng nào không hiểu? "có dòng lệnh này em vẫn chưa hiểu" trong khi đưa cả tập lệnh mà không chỉ dòng nào là sao?
Nhấp chuột vào đây để mở rộng...
dạ chào anh. em chưa hiểu tập lệnh này anh ạ. Em có file đính kèm ở sheet account em muốn thêm mấy account nữa vào. mà em create button "insert bottom row" mà không hoạt động. Mong anh chỉ giáo giúp em.
Set ARange = Range(AccountFrame) câu lệnh này báo lỗi anh ạ.
 

File đính kèm

Upvote 0
tototolon_123 đã viết:
dạ chào anh. em chưa hiểu tập lệnh này anh ạ. Em có file đính kèm ở sheet account em muốn thêm mấy account nữa vào. mà em create button "insert bottom row" mà không hoạt động. Mong anh chỉ giáo giúp em.
Set ARange = Range(AccountFrame) câu lệnh này báo lỗi anh ạ.
Nhấp chuột vào đây để mở rộng...
Bạn dò xem biến AccountFrame nạp dữ liệu địa chỉ vùng bảng tính từ đâu, lúc nào? Biến này rỗng hoặc sai là lệnh set range bị lỗi.
 
Upvote 0
Nhờ Thầy cô anh, chị hướng dẫn code ShowFilterFile như sau
Khi sheet Data có Filter thì xả filter (các sheet khác không xả)
Mã: 
Sub ShowFilterFile()
        If Sheets("Data").AutoFilterMode Then
            ActiveSheet.ShowAllData
        End If
End Sub
code trên chỉ đúng khi sheet Data có filter, còn không có thì nó báo lỗi ở dòng
Mã: 
  ActiveSheet.ShowAllData
Làm sao khi sheet Data không có filter thì nó bỏ qua
Lưu ý: không bỏ các mũi tên filter
Em cảm ơn!
 
Upvote 0
AnhThu-1976 đã viết:
Nhờ Thầy cô anh, chị hướng dẫn code ShowFilterFile như sau
Khi sheet Data có Filter thì xả filter (các sheet khác không xả)
Mã: 
Sub ShowFilterFile()
        If Sheets("Data").AutoFilterMode Then
            ActiveSheet.ShowAllData
        End If
End Sub
code trên chỉ đúng khi sheet Data có filter, còn không có thì nó báo lỗi ở dòng
Mã: 
  ActiveSheet.ShowAllData
Làm sao khi sheet Data không có filter thì nó bỏ qua
Lưu ý: không bỏ các mũi tên filter
Em cảm ơn!
Nhấp chuột vào đây để mở rộng...
Thêm lệnh On errror resume Next là đc mà.
 
Upvote 0
PHP: 
'.......................
Dim Dict
Dim k1 As String, k2 As String, k3 As String
For i = 1 to j
'......................
Dict.Add k1, i
'......................
Dict.Add k2, i
'......................
Dict.Add k3, i
'......................
'Gan toan bo Dict.Item có trong Dict xuong Sheets1.Range("F1")
Next i

Với mỗi 1 cú pháp "If - End If" và 1 đơn vị của " i " thì em Add vào Dictionary(VBA) được một Key.
Giá trị i chạy đến j thì em được tập hợp các Key đã Add vào Dict lần lượt là k1, k2, k3
Cuối cùng: Muốn dán toàn bộ Key có trong Dictionary (VBA) xuống Sheet1 tại ô F1 thì cú pháp làm sao ạ. Xin chỉ giúp em với ạ!
 
Upvote 0
Mã: 
Option Explicit

Public Sub Gpe()
Dim sArr(), dArr(), I As Long, Txt As String, R As Long
    sArr = Range("C3", Range("D50000").End(xlUp)).Resize(, 2).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 1)
For I = 1 To R
    If Len(sArr(I, 2)) > 10 Then Txt = sArr(I, 2)
    dArr(I, 1) = Txt
Next I
Range("A3").Resize(R) = dArr
End Sub

Sub TimKiem()
Dim Rng As Range, R As Long, Txt As String
    R = Range("A50000").End(xlUp).Row
Set Rng = Range("A2:A" & R)
    Txt = Range("A1").Value
    If Len(Txt) Then
        Rng.AutoFilter Field:=1, Criteria1:=Txt
    Else
        Rng.AutoFilter
    End If
End Sub
với Code hiện tại thì khi cần tìm kiếm phải chỉ đích danh chuỗi : Số đơn hàng/mã hàng/màu sắc / số lượng / quốc gia : (226142/S8113TW/A05=312 Mỹ)
Em nên topic mong nhận được sự chỉ dẫn 1 đoạn Code Chỉ cần tìm kiếm dạng chuỗi : Số đơn hàng/mã hàng/màu sắc ( 226142/S8113TW/A05 ) và ở dạng tìm kiếm rộng hơn là Số đơn hàng/mã hàng ( 226142/S8113TW )- là đã có thể lọc ra kết quả cần tìm kiếm
Em xin cảm ơn ạ !1615019754951.png
 

File đính kèm

Upvote 0
Code này chạy mất 6s:
Mã: 
Sub TinhLaiNhapXuatTon_NEW()
Dim lrMaHang As Long
With Sheets("MAHANG")
    lrMaHang = .Range("E" & Rows.Count).End(xlUp).Row
    If lrMaHang < 9 Then Exit Sub
    .Range("U9:Z10008").ClearContents
    .Range("U9:U" & lrMaHang).Formula = "=SUMIFS(SOLUONG_NK,TENHANG_NK,rc[-16]) - SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-16],GHICHU_XE,""Nhap Lai Kho"")-(SUMIFS(SOLUONG_XK,TENHANG_XK,rc[-16],XEBAN_XK,"""")+SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-16],GHICHU_XE,""Kho Len Xe""))"
    .Range("W9:W" & lrMaHang).Formula = "=SUMIFS(SOLUONG_NK,TENHANG_NK,rc[-18],NGAY_NK,""<""&TUNGAY_MH) - SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-18],NGAY_XE,""<""&TUNGAY_MH,GHICHU_XE,""Nhap Lai Kho"")-(SUMIFS(SOLUONG_XK,TENHANG_XK,rc[-18],NGAY_BH,""<""&TUNGAY_MH,XEBAN_XK,"""")+SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-18],NGAY_XE,""<""&TUNGAY_MH,GHICHU_XE,""Kho Len Xe""))"
    .Range("X9:X" & lrMaHang).Formula = "=SUMIFS(SOLUONG_NK,TENHANG_NK,rc[-19],NGAY_NK,"">=""&TUNGAY_MH,NGAY_NK,""<=""&DENNGAY_MH) - SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-19],NGAY_XE,"">=""&TUNGAY_MH,NGAY_XE,""<=""&DENNGAY_MH,GHICHU_XE,""Nhap Lai Kho"")"
    .Range("Y9:Y" & lrMaHang).Formula = "=SUMIFS(SOLUONG_XK,TENHANG_XK,rc[-20],NGAY_BH,"">=""&TUNGAY_MH,NGAY_BH,""<=""&DENNGAY_MH,XEBAN_XK,"""")+SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-20],NGAY_XE,"">=""&TUNGAY_MH,NGAY_XE,""<=""&DENNGAY_MH,GHICHU_XE,""Kho Len Xe"")"
    .Range("Z9:Z" & lrMaHang).Formula = "=RC[-3] + RC[-2] - RC[-1]"
    .Range("U9:Z" & lrMaHang).Value = .Range("U9:Z" & lrMaHang).Value
End With

End Sub

Nhưng sau khi thêm dòng này vào: Application.Calculation = xlCalculationManual thì thì chỉ mất 0.007 giây, vẫn ra kết quả.
Mã: 
Sub TinhLaiNhapXuatTon_NEW()

Application.Calculation = xlCalculationManual
'Dim t As Single
't = Timer
''code

Dim lrMaHang As Long
With Sheets("MAHANG")
    lrMaHang = .Range("E" & Rows.Count).End(xlUp).Row
    If lrMaHang < 9 Then Exit Sub
    .Range("U9:Z10008").ClearContents
    .Range("U9:U" & lrMaHang).Formula = "=SUMIFS(SOLUONG_NK,TENHANG_NK,rc[-16]) - SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-16],GHICHU_XE,""Nhap Lai Kho"")-(SUMIFS(SOLUONG_XK,TENHANG_XK,rc[-16],XEBAN_XK,"""")+SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-16],GHICHU_XE,""Kho Len Xe""))"
    .Range("W9:W" & lrMaHang).Formula = "=SUMIFS(SOLUONG_NK,TENHANG_NK,rc[-18],NGAY_NK,""<""&TUNGAY_MH) - SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-18],NGAY_XE,""<""&TUNGAY_MH,GHICHU_XE,""Nhap Lai Kho"")-(SUMIFS(SOLUONG_XK,TENHANG_XK,rc[-18],NGAY_BH,""<""&TUNGAY_MH,XEBAN_XK,"""")+SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-18],NGAY_XE,""<""&TUNGAY_MH,GHICHU_XE,""Kho Len Xe""))"
    .Range("X9:X" & lrMaHang).Formula = "=SUMIFS(SOLUONG_NK,TENHANG_NK,rc[-19],NGAY_NK,"">=""&TUNGAY_MH,NGAY_NK,""<=""&DENNGAY_MH) - SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-19],NGAY_XE,"">=""&TUNGAY_MH,NGAY_XE,""<=""&DENNGAY_MH,GHICHU_XE,""Nhap Lai Kho"")"
    .Range("Y9:Y" & lrMaHang).Formula = "=SUMIFS(SOLUONG_XK,TENHANG_XK,rc[-20],NGAY_BH,"">=""&TUNGAY_MH,NGAY_BH,""<=""&DENNGAY_MH,XEBAN_XK,"""")+SUMIFS(SOLUONG_XE,TENHANG_XE,rc[-20],NGAY_XE,"">=""&TUNGAY_MH,NGAY_XE,""<=""&DENNGAY_MH,GHICHU_XE,""Kho Len Xe"")"
    .Range("Z9:Z" & lrMaHang).Formula = "=RC[-3] + RC[-2] - RC[-1]"
    .Range("U9:Z" & lrMaHang).Value = .Range("U9:Z" & lrMaHang).Value
End With
'MsgBox Timer - t
Application.Calculation = xlCalculationAutomatic

End Sub

Cho em hỏi tại sao có sự khác biệt như vậy ạ? em cứ nghĩ thêm Application.Calculation = xlCalculationManual thì excel sẽ ngưng tính toán, và công thức kia gán xuống sheets cũng ko chạy được chứ nhỉ?
Mong cả nhà giải đáp giúp em để em thông suốt ạ!
 
Upvote 0
Em có cái lệnh VBA tách 100 dòng ra 1 file nhưng khi tách nó ko dư lại tiêu đề của nội dung. Em muốn nhờ các bác sửa hộ em lệnh cho nó dữ lại tiêu đề ở các file tác ra ạ. code VBA em đính kèm ạ. Em cảm ơn các bác nhiều
 

File đính kèm

Upvote 0
kiendaide1 đã viết:
Em có cái lệnh VBA tách 100 dòng ra 1 file nhưng khi tách nó ko dư lại tiêu đề của nội dung. Em muốn nhờ các bác sửa hộ em lệnh cho nó dữ lại tiêu đề ở các file tác ra ạ. code VBA em đính kèm ạ. Em cảm ơn các bác nhiều
Nhấp chuột vào đây để mở rộng...
Mình quăng chài vừa thôi chứ.

Quăng nhiều thế là hư lưới đó.


1615198101863.png
 
Upvote 0
Em lượm nhặt được code của anh huuthang_bd về đổi số thành chữ, nhưng không biết cách ghép thêm chữ "đồng" vào cuối đoạn code này, anh chị nào có thể giúp em để em tạo add in được ok ạ
Mã: 
'huuthang_bd - giaiphapexcel.com
Function DocSo(ByVal Number, Optional ByVal Font = 1) As String
Dim MyArray
Dim Str
Str = Format(Abs(Number), "000000000000000000")
Select Case Font
Case 1
MyArray = Array("không ", "m" & ChrW(7897) & "t ", "hai ", "ba ", "b" & ChrW(7889) & "n ", "n" & ChrW(259) & "m ", "sáu ", "b" & ChrW(7843) & "y ", "tám ", "chín ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "t" & ChrW(7927) & ", ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "", "tr" & ChrW(259) & "m ", "m" & ChrW(432) & ChrW(417) & "i ", "không " & "m" & ChrW(432) & ChrW(417) & "i" & " không ", "không " & "m" & ChrW(432) & ChrW(417) & "i", "l" & ChrW(7867), "m" & ChrW(432) & ChrW(417) & "i" & " không", "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " n" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(417) & "i" & " l" & ChrW(259) & "m", "m" & ChrW(7897) & "t " & "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(7901) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7897) & "t", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7889) & "t", "Âm ")
Case 2
MyArray = Array("khoâng ", "moät ", "hai ", "ba ", "boán ", "naêm ", "saùu ", "baûy ", "taùm ", "chín ", "trieäu, ", "ngaøn, ", "tyû, ", "trieäu, ", "ngaøn, ", "", "traêm ", "möôi ", "khoâng möôi khoâng ", "khoâng möôi", "leû", "möôi khoâng", "möôi", "möôi naêm", "möôi laêm", "moät möôi", "möôøi", "möôi moät", "möôi moát", "AÂm ")
Case 3
MyArray = Array("kh«ng ", "mét ", "hai ", "ba ", "bèn ", "n¨m ", "s¸u ", "b¶y ", "t¸m ", "chÝn ", "triÖu, ", "ngµn, ", "tû, ", "triÖu, ", "ngµn, ", "", "tr¨m ", "m¬i ", "kh«ng m¬i kh«ng ", "kh«ng m¬i", "lÎ", "m¬i kh«ng", "m¬i", "m¬i n¨m", "m¬i l¨m", "mét m¬i", "mêi", "m¬i mét", "m¬i mèt", "©m ")
End Select
If Str = "000000000000000000" Then
    DocSo = UCase(Left(MyArray(0), 1)) & Trim(Mid(MyArray(0), 2)) & "."
    Exit Function
End If
For i = 1 To Len(Str)
If Left(Str, i) <> 0 And Mid(Str, (Int((i + 2) / 3) - 1) * 3 + 1, 3) <> 0 Then
    DocSo = DocSo & MyArray(Mid(Str, i, 1)) & MyArray(-(9 + i / 3) * (i Mod 3 = 0) - (15 + i Mod 3) * (i Mod 3 <> 0))
ElseIf i = 9 And Mid(Str, 7, 3) = 0 And Left(Str, 6) <> 0 Then
    DocSo = DocSo & MyArray(12)
End If
Next
DocSo = Trim(Replace(Replace(Replace(Replace(Replace(Replace(DocSo, MyArray(18), MyArray(15)), MyArray(19), MyArray(20)), MyArray(21), MyArray(22)), MyArray(23), MyArray(24)), MyArray(25), MyArray(26)), MyArray(27), MyArray(28)))
If Number < 0 Then
DocSo = MyArray(29) & DocSo
End If
DocSo = Replace(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & ".", ",.", ".")
End Function
Em cám ơn ạ !
 
Upvote 0
iamnobika đã viết:
Em lượm nhặt được code của anh huuthang_bd về đổi số thành chữ, nhưng không biết cách ghép thêm chữ "đồng" vào cuối đoạn code này, anh chị nào có thể giúp em để em tạo add in được ok ạ
Mã: 
'huuthang_bd - giaiphapexcel.com
Function DocSo(ByVal Number, Optional ByVal Font = 1) As String
Dim MyArray
Dim Str
Str = Format(Abs(Number), "000000000000000000")
Select Case Font
Case 1
MyArray = Array("không ", "m" & ChrW(7897) & "t ", "hai ", "ba ", "b" & ChrW(7889) & "n ", "n" & ChrW(259) & "m ", "sáu ", "b" & ChrW(7843) & "y ", "tám ", "chín ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "t" & ChrW(7927) & ", ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "", "tr" & ChrW(259) & "m ", "m" & ChrW(432) & ChrW(417) & "i ", "không " & "m" & ChrW(432) & ChrW(417) & "i" & " không ", "không " & "m" & ChrW(432) & ChrW(417) & "i", "l" & ChrW(7867), "m" & ChrW(432) & ChrW(417) & "i" & " không", "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " n" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(417) & "i" & " l" & ChrW(259) & "m", "m" & ChrW(7897) & "t " & "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(7901) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7897) & "t", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7889) & "t", "Âm ")
Case 2
MyArray = Array("khoâng ", "moät ", "hai ", "ba ", "boán ", "naêm ", "saùu ", "baûy ", "taùm ", "chín ", "trieäu, ", "ngaøn, ", "tyû, ", "trieäu, ", "ngaøn, ", "", "traêm ", "möôi ", "khoâng möôi khoâng ", "khoâng möôi", "leû", "möôi khoâng", "möôi", "möôi naêm", "möôi laêm", "moät möôi", "möôøi", "möôi moät", "möôi moát", "AÂm ")
Case 3
MyArray = Array("kh«ng ", "mét ", "hai ", "ba ", "bèn ", "n¨m ", "s¸u ", "b¶y ", "t¸m ", "chÝn ", "triÖu, ", "ngµn, ", "tû, ", "triÖu, ", "ngµn, ", "", "tr¨m ", "m¬i ", "kh«ng m¬i kh«ng ", "kh«ng m¬i", "lÎ", "m¬i kh«ng", "m¬i", "m¬i n¨m", "m¬i l¨m", "mét m¬i", "mêi", "m¬i mét", "m¬i mèt", "©m ")
End Select
If Str = "000000000000000000" Then
    DocSo = UCase(Left(MyArray(0), 1)) & Trim(Mid(MyArray(0), 2)) & "."
    Exit Function
End If
For i = 1 To Len(Str)
If Left(Str, i) <> 0 And Mid(Str, (Int((i + 2) / 3) - 1) * 3 + 1, 3) <> 0 Then
    DocSo = DocSo & MyArray(Mid(Str, i, 1)) & MyArray(-(9 + i / 3) * (i Mod 3 = 0) - (15 + i Mod 3) * (i Mod 3 <> 0))
ElseIf i = 9 And Mid(Str, 7, 3) = 0 And Left(Str, 6) <> 0 Then
    DocSo = DocSo & MyArray(12)
End If
Next
DocSo = Trim(Replace(Replace(Replace(Replace(Replace(Replace(DocSo, MyArray(18), MyArray(15)), MyArray(19), MyArray(20)), MyArray(21), MyArray(22)), MyArray(23), MyArray(24)), MyArray(25), MyArray(26)), MyArray(27), MyArray(28)))
If Number < 0 Then
DocSo = MyArray(29) & DocSo
End If
DocSo = Replace(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & ".", ",.", ".")
End Function
Em cám ơn ạ !
Nhấp chuột vào đây để mở rộng...
Bạn thử đoạn dưới nhé:
Rich (BB code): 
'huuthang_bd - giaiphapexcel.com
Function DocSo(ByVal Number, Optional ByVal Font = 1) As String
Dim MyArray
Dim Str
Str = Format(Abs(Number), "000000000000000000")
Select Case Font
Case 1
MyArray = Array("không ", "m" & ChrW(7897) & "t ", "hai ", "ba ", "b" & ChrW(7889) & "n ", "n" & ChrW(259) & "m ", "sáu ", "b" & ChrW(7843) & "y ", "tám ", "chín ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "t" & ChrW(7927) & ", ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "", "tr" & ChrW(259) & "m ", "m" & ChrW(432) & ChrW(417) & "i ", "không " & "m" & ChrW(432) & ChrW(417) & "i" & " không ", "không " & "m" & ChrW(432) & ChrW(417) & "i", "l" & ChrW(7867), "m" & ChrW(432) & ChrW(417) & "i" & " không", "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " n" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(417) & "i" & " l" & ChrW(259) & "m", "m" & ChrW(7897) & "t " & "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(7901) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7897) & "t", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7889) & "t", "Âm ")
Case 2
MyArray = Array("khoâng ", "moät ", "hai ", "ba ", "boán ", "naêm ", "saùu ", "baûy ", "taùm ", "chín ", "trieäu, ", "ngaøn, ", "tyû, ", "trieäu, ", "ngaøn, ", "", "traêm ", "möôi ", "khoâng möôi khoâng ", "khoâng möôi", "leû", "möôi khoâng", "möôi", "möôi naêm", "möôi laêm", "moät möôi", "möôøi", "möôi moät", "möôi moát", "AÂm ")
Case 3
MyArray = Array("kh«ng ", "mét ", "hai ", "ba ", "bèn ", "n¨m ", "s¸u ", "b¶y ", "t¸m ", "chÝn ", "triÖu, ", "ngµn, ", "tû, ", "triÖu, ", "ngµn, ", "", "tr¨m ", "m¬i ", "kh«ng m¬i kh«ng ", "kh«ng m¬i", "lÎ", "m¬i kh«ng", "m¬i", "m¬i n¨m", "m¬i l¨m", "mét m¬i", "mêi", "m¬i mét", "m¬i mèt", "©m ")
End Select
If Str = "000000000000000000" Then
    DocSo = UCase(Left(MyArray(0), 1)) & Trim(Mid(MyArray(0), 2)) & "."
    Exit Function
End If
For i = 1 To Len(Str)
If Left(Str, i) <> 0 And Mid(Str, (Int((i + 2) / 3) - 1) * 3 + 1, 3) <> 0 Then
    DocSo = DocSo & MyArray(Mid(Str, i, 1)) & MyArray(-(9 + i / 3) * (i Mod 3 = 0) - (15 + i Mod 3) * (i Mod 3 <> 0))
ElseIf i = 9 And Mid(Str, 7, 3) = 0 And Left(Str, 6) <> 0 Then
    DocSo = DocSo & MyArray(12)
End If
Next
DocSo = Trim(Replace(Replace(Replace(Replace(Replace(Replace(DocSo, MyArray(18), MyArray(15)), MyArray(19), MyArray(20)), MyArray(21), MyArray(22)), MyArray(23), MyArray(24)), MyArray(25), MyArray(26)), MyArray(27), MyArray(28)))
If Number < 0 Then
DocSo = MyArray(29) & DocSo
End If
'DocSo = Replace(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & ".", ",.", ".")
DocSo = DocSo(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & ".", ",.", " ") & ChrW$(273) & ChrW$(7891) & "ng."
DocSo = Replace(DocSo, "." & ChrW$(273) & ChrW$(7891) & "ng.", " " & ChrW$(273) & ChrW$(7891) & "ng.")
End Function
 
Upvote 0
iamnobika đã viết:
Bị lỗi rồi a ạ, bảo sao lúc thêm add in nó ko gọi hàm ra đc
View attachment 255251
Nhấp chuột vào đây để mở rộng...

Bạn thử lại nhé:
Rich (BB code): 
'huuthang_bd - giaiphapexcel.com
Function DocSo(ByVal Number, Optional ByVal Font = 1) As String
Dim MyArray
Dim Str
Str = Format(Abs(Number), "000000000000000000")
Select Case Font
Case 1
MyArray = Array("không ", "m" & ChrW(7897) & "t ", "hai ", "ba ", "b" & ChrW(7889) & "n ", "n" & ChrW(259) & "m ", "sáu ", "b" & ChrW(7843) & "y ", "tám ", "chín ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "t" & ChrW(7927) & ", ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "", "tr" & ChrW(259) & "m ", "m" & ChrW(432) & ChrW(417) & "i ", "không " & "m" & ChrW(432) & ChrW(417) & "i" & " không ", "không " & "m" & ChrW(432) & ChrW(417) & "i", "l" & ChrW(7867), "m" & ChrW(432) & ChrW(417) & "i" & " không", "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " n" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(417) & "i" & " l" & ChrW(259) & "m", "m" & ChrW(7897) & "t " & "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(7901) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7897) & "t", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7889) & "t", "Âm ")
Case 2
MyArray = Array("khoâng ", "moät ", "hai ", "ba ", "boán ", "naêm ", "saùu ", "baûy ", "taùm ", "chín ", "trieäu, ", "ngaøn, ", "tyû, ", "trieäu, ", "ngaøn, ", "", "traêm ", "möôi ", "khoâng möôi khoâng ", "khoâng möôi", "leû", "möôi khoâng", "möôi", "möôi naêm", "möôi laêm", "moät möôi", "möôøi", "möôi moät", "möôi moát", "AÂm ")
Case 3
MyArray = Array("kh«ng ", "mét ", "hai ", "ba ", "bèn ", "n¨m ", "s¸u ", "b¶y ", "t¸m ", "chÝn ", "triÖu, ", "ngµn, ", "tû, ", "triÖu, ", "ngµn, ", "", "tr¨m ", "m¬i ", "kh«ng m¬i kh«ng ", "kh«ng m¬i", "lÎ", "m¬i kh«ng", "m¬i", "m¬i n¨m", "m¬i l¨m", "mét m¬i", "mêi", "m¬i mét", "m¬i mèt", "©m ")
End Select
If Str = "000000000000000000" Then
    DocSo = UCase(Left(MyArray(0), 1)) & Trim(Mid(MyArray(0), 2)) & "."
    Exit Function
End If
For i = 1 To Len(Str)
If Left(Str, i) <> 0 And Mid(Str, (Int((i + 2) / 3) - 1) * 3 + 1, 3) <> 0 Then
    DocSo = DocSo & MyArray(Mid(Str, i, 1)) & MyArray(-(9 + i / 3) * (i Mod 3 = 0) - (15 + i Mod 3) * (i Mod 3 <> 0))
ElseIf i = 9 And Mid(Str, 7, 3) = 0 And Left(Str, 6) <> 0 Then
    DocSo = DocSo & MyArray(12)
End If
Next
DocSo = Trim(Replace(Replace(Replace(Replace(Replace(Replace(DocSo, MyArray(18), MyArray(15)), MyArray(19), MyArray(20)), MyArray(21), MyArray(22)), MyArray(23), MyArray(24)), MyArray(25), MyArray(26)), MyArray(27), MyArray(28)))
If Number < 0 Then
DocSo = MyArray(29) & DocSo
End If
'DocSo = Replace(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & ".", ",.", ".")
DocSo = Replace(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & ".", ",.", " ") & ChrW$(273) & ChrW$(7891) & "ng."
DocSo = Replace(DocSo, "." & ChrW$(273) & ChrW$(7891) & "ng.", " " & ChrW$(273) & ChrW$(7891) & "ng.")
End Function
 
Upvote 0
1615708312890.png
Làm cách nào để em có thể khai báo biến i để có thể chọn được 1 dòng, hai dòng nhiều dòng theo ý mình chọn để coppy sang sheet khác ạ. Em mới biết VBA nên không rõ cách làm. Mong được giúp đỡ. Em cảm ơn nhiều!!!!
 
Upvote 0
Hân Đỗ đã viết:
View attachment 255395
Làm cách nào để em có thể khai báo biến i để có thể chọn được 1 dòng, hai dòng nhiều dòng theo ý mình chọn để coppy sang sheet khác ạ. Em mới biết VBA nên không rõ cách làm. Mong được giúp đỡ. Em cảm ơn nhiều!!!!
Nhấp chuột vào đây để mở rộng...
Bạn nêu rõ điều kiện và ví dụ kết quả mong muốn vào file gửi lên xem thế nào nhé.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

Q
Không chỉnh sửa, copy được hình ảnh trong file excel. (4 người xem)
Trả lời
6
Đọc
4K
thaivanthao
T
L
Nhờ giúp file word (3 người xem)
Trả lời
1
Đọc
80
minhminh27
minhminh27
GPE-Trợ Lý
[GPE] TASKSHOW 14: TỪ BẢNG TÍNH ĐẾN BÁO CÁO ĐỘNG - BẮT ĐẦU VỚI LOOKER STUDIO (4 người xem)
    • Thích
Trả lời
1
Đọc
11K
GPE-Trợ Lý
GPE-Trợ Lý
dungluyen2119
  • Question Question
Code VBA để tính tổng theo chiều ngang mà số cột không cố định (1 người xem)
Trả lời
5
Đọc
259
dungluyen2119
dungluyen2119
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
390
Đọc
46K
phdong
P
8
Theo dõi bán hàng
Trả lời
10
Đọc
309
84huong
8
L
  • Question Question
Nhờ sửa code ChrW () (1 người xem)
Trả lời
2
Đọc
95
le_vis
L
N
  • Question Question
Hỗ trợ tiếng việt trong macro
Trả lời
12
Đọc
525
Quang_Hải
Quang_Hải
D
xin hỏi về lỗi mô đun ẩn.
Trả lời
6
Đọc
295
du trung kien
D
haohvnh
Lỗi hàm SUM không hiển thị ra kết quả
Trả lời
19
Đọc
45K
ptm0412
ptm0412
minhduc1o2
Hình ảnh bị lỗi #VALUE (1 người xem)
Trả lời
5
Đọc
175
minhduc1o2
minhduc1o2
ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
5
Đọc
310
ongke0711
ongke0711
befaint
Chia sẻ tâm tư, xả nỗi lòng (1 người xem)
    • Thích
6 7 8
Trả lời
761
Đọc
61K
SA_DQ
SA_DQ
S
  • Question Question
Object.close và Set Object = nothing
Trả lời
14
Đọc
1K
nguyendang95
N
H
Lỗi khi sort data xin được hỗ trợ (1 người xem)
Trả lời
2
Đọc
123
hunglq48
H
Nguyenkhang2404
Tính định mức sản phẩm
    • Chấp nhận
Trả lời
9
Đọc
371
Nguyenkhang2404
Nguyenkhang2404
T
Ngắt kết nối với tệp lệnh đính kèm
Trả lời
2
Đọc
136
TungXauGiai
T
ongke0711
  • Question Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3
Trả lời
277
Đọc
35K
joker102
J
S
tỷ lệ % không khớp khi cộng tổng
Trả lời
2
Đọc
112
snoobcool
S
D
Tên sheet bị che khuất khi thực hiện sửa tên sheet
Trả lời
1
Đọc
273
PhamMaiTB
P
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom