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

[maytinhvp01]

Mình muốn nhờ giải thich câu lệnh " If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c) "
trong ví du:
Public Function LonNhat(Ran As Range)
Dim max As Double, v As Integer, d As Integer, c As Integer
max = Ran.Cells(1, 1)
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c)
Next c
Next d
v = Tim(max, Ran)
LonNhat = max
End Function
-------------------------------------------------------
[INFO1]Thông báo:
Vì topic này:
http://www.giaiphapexcel.com/forum/...ải-thích-các-code-đề-nghị-các-bạn-gửi-vào-đây
đã quá dài nên BQT đóng lại.
Nay tôi mở topic mới với cùng chủ đề: GIẢI THÍCH NHỮNG THẮC MẮC VỀ CODE
Các bạn nếu có nhu cầu giải thích code, vui lòng post tại đây nhé
NDU96081631
[/INFO1]

 

[HieuCD]

Nhờ các thầy cô rút ngẵn đoạn code giúp em được không ạ

Sub Boimau()
  Dim Ws As Worksheet, TenSheet As String
  TenSheet = "#UU#YE#YG#YH#YJ#YN#YQ#YP#YR#YS#YT#QQ#NN#PP#VV#SS#TT#RR#"
  For Each Ws In Worksheets
    If InStr(1, TenSheet, "#" & Ws.Name & "#") > 0 Then
      With Ws.Range("N11:O38").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
      End With
    End If
  Next Ws
End Sub

 

[BuiQuangThuan]

Cám ơn các thầy cô ạ

 

[BuiQuangThuan]

Sub XuatPDF()
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF
FileName = "ThisWorkbook & Name.pdf"
Quality = xlQualityStandard
IncludeDocProperties = True
IgnorePrintAreas = False
End Sub

Nhờ các thầy cô sửa giúp em đoạn code trên với ạ. Em muốn xuất tất cả sheet trong cùng 1 file. nhưng cái code trên nó lại chỉ xuất cái sheet hiện hành.
Nếu em muốn xuất PDF mà nó lưu vào khu vực mình muốn thì thêm code như nào ạ

 

[befaint]

Nhờ các thầy cô sửa giúp em đoạn code trên với ạ. Em muốn xuất tất cả sheet trong cùng 1 file. nhưng cái code trên nó lại chỉ xuất cái sheet hiện hành.
Nếu em muốn xuất PDF mà nó lưu vào khu vực mình muốn thì thêm code như nào ạ

Sub Main()
    Const thumuc_gioidanh As String = "D:\Gioi danh"
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If ws.Visible = xlSheetVisible Then
            Luu_PDF ws, thumuc_gioidanh
        End If
    Next ws
End Sub

Sub Luu_PDF(ByVal ws As Worksheet, ByVal Noi_luu As String)
    ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Noi_luu & "\" & ws.Name & ".pdf"
End Sub

 

[BuiQuangThuan]

ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Noi_luu & "\" & ws.Name & ".pdf"

nó báo lỗi ở dòng này ạ

 

[befaint]

nó báo lỗi ở dòng này ạ

Thì kệ nó đi bạn. Lỗi thì không tạo ra được file *.pdf >> không giải quyết được công việc >> Mệt người.

 

[BuiQuangThuan]

Thì kệ nó đi bạn. Lỗi thì không tạo ra được file *.pdf >> không giải quyết được công việc >> Mệt người.

Hihi. Dù Sao thì cung cám ơn ạ.

 

[guitarnguyen1989]

Nhờ mọi người giải thích dùm em ý nghĩa đoạn code bên dưới , qua trọng các dòng em đánh số .
code lồng nhiều hàm if quá ko hiểu nổi !!!

Sub fifoNL()
  Dim nhapArr(), xuatArr(), Res()
  Dim I As Long, n As Long, sRow As Long
  Dim sNhap As Double, sXuat As Double, dXuat As Date
  Dim Ma As String, tmp As String
  With Sheets("DATANL")
    I = .Range("A" & Rows.Count).End(xlUp).Row
    If I < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    nhapArr = .Range("A3:D" & I).Value
    I = .Range("F" & Rows.Count).End(xlUp).Row
    If I < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    xuatArr = .Range("F3:H" & I).Value
    sRow = UBound(xuatArr)
1    ReDim Res(1 To sRow, 1 To 1)
  End With
  For I = 1 To sRow
    dXuat = xuatArr(I, 1): Ma = xuatArr(I, 2): sXuat = xuatArr(I, 3)
2     tmp = ""
    If Len(Ma) > 0 And sXuat > 0 Then
      For n = 1 To UBound(nhapArr)
        If nhapArr(n, 1) > dXuat Then Exit For
        If nhapArr(n, 2) = Ma Then
          sNhap = nhapArr(n, 3)
          If sNhap > 0 Then
            If sNhap >= sXuat Then
3              Res(I, 1) = tmp & nhapArr(n, 4)
4              If Len(tmp) > 0 Then Res(I, 1) = Res(I, 1) & "(" & sXuat & ")"
              nhapArr(n, 3) = sNhap - sXuat
              sXuat = 0
              Exit For
            Else
5              tmp = tmp & nhapArr(n, 4) & "(" & sNhap & "); "
              nhapArr(n, 3) = 0
              sXuat = sXuat - sNhap
            End If
          End If
        End If
      Next n
6      If sXuat > 0 Then Res(I, 1) = tmp & "Thieu(" & sXuat & ")"
    End If
  Next I
7  Sheets("DATANL").Range("I3").Resize(sRow) = Res
End Sub

 

[CHAOQUAY]

Nhờ mọi người giải thích dùm em ý nghĩa đoạn code bên dưới , qua trọng các dòng em đánh số .
code lồng nhiều hàm if quá ko hiểu nổi !!!

Sub fifoNL()
  Dim nhapArr(), xuatArr(), Res()
  Dim I As Long, n As Long, sRow As Long
  Dim sNhap As Double, sXuat As Double, dXuat As Date
  Dim Ma As String, tmp As String
  With Sheets("DATANL")
    I = .Range("A" & Rows.Count).End(xlUp).Row
    If I < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    nhapArr = .Range("A3:D" & I).Value
    I = .Range("F" & Rows.Count).End(xlUp).Row
    If I < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    xuatArr = .Range("F3:H" & I).Value
    sRow = UBound(xuatArr)
1    ReDim Res(1 To sRow, 1 To 1)
  End With
  For I = 1 To sRow
    dXuat = xuatArr(I, 1): Ma = xuatArr(I, 2): sXuat = xuatArr(I, 3)
2     tmp = ""
    If Len(Ma) > 0 And sXuat > 0 Then
      For n = 1 To UBound(nhapArr)
        If nhapArr(n, 1) > dXuat Then Exit For
        If nhapArr(n, 2) = Ma Then
          sNhap = nhapArr(n, 3)
          If sNhap > 0 Then
            If sNhap >= sXuat Then
3              Res(I, 1) = tmp & nhapArr(n, 4)
4              If Len(tmp) > 0 Then Res(I, 1) = Res(I, 1) & "(" & sXuat & ")"
              nhapArr(n, 3) = sNhap - sXuat
              sXuat = 0
              Exit For
            Else
5              tmp = tmp & nhapArr(n, 4) & "(" & sNhap & "); "
              nhapArr(n, 3) = 0
              sXuat = sXuat - sNhap
            End If
          End If
        End If
      Next n
6      If sXuat > 0 Then Res(I, 1) = tmp & "Thieu(" & sXuat & ")"
    End If
  Next I
7  Sheets("DATANL").Range("I3").Resize(sRow) = Res
End Sub

Nếu muốn rõ ràng thì bạn nên gửi kèm theo file chứa code lên cho nhanh

 

[VetMini]

Đọc code này thấy sặc mùi sì tin GPE.
Lấy ở thớt nào thì chịu khó cho luôn đường dẫn, bà con khỏi mất công tìm hiểu.
(ví dụ có những chỗ code dở hay sai, không thấy ngữ cảnh làm sao biết)

 

[NghiaKieu]

Em mới học VBA mà tìm và thử mãi vẫn chưa làm được chọn ô cuối cùng của mảng vừa chọn. Nhờ các bác giúp đỡ với ạ.
Trân trọng cảm ơn!

Sub Chon_o_cuoi()
'
    Sheets("Sheet1").range("mang1").Select
'    Cần code tiếp theo để đưa chuột về ô cuối cùng của mảng "mang1"

End Sub

 

[SA_DQ]

Em mới học VBA mà tìm và thử mãi vẫn chưa làm được chọn ô cuối cùng của mảng vừa chọn. Nhờ các bác giúp đỡ với ạ.
Trân trọng cảm ơn!

Sub Chon_O_Cuoi()
    Sheets("Sheet1").Range("mang1").Select
    With Selection
        If .Columns.Count = 1 Then
            .Offset()(.Rows.Count).Select
        Else
            .Offset()(.Cells.Count).Select
        End If
        MsgBox Selection.Address
    End With
End Sub

 

[HieuCD]

Em mới học VBA mà tìm và thử mãi vẫn chưa làm được chọn ô cuối cùng của mảng vừa chọn. Nhờ các bác giúp đỡ với ạ.
Trân trọng cảm ơn!

Sub Chon_o_cuoi()
  Sheets("Sheet1").Range("mang1").Select
  Selection(Selection.Rows.Count, Selection.Columns.Count).Select
End Sub

 

[SA_DQ]

Sub Chon_o_cuoi()
' . . . . '
End Sub

Sub Chon_O_Cuoi()
 '  Range1 = Union(Range("A2:B3"), [C1: D9])        '
    Sheets("Sheet1").Range("Range1").Select
    Selection(Selection.Rows.Count, Selection.Columns.Count).Select
    MsgBox Selection.Address
End Sub

 

[HieuCD]

Sub Chon_O_Cuoi()
'  Range1 = Union(Range("A2:B3"), [C1: D9])        '
    Sheets("Sheet1").Range("Range1").Select
    Selection(Selection.Rows.Count, Selection.Columns.Count).Select
    MsgBox Selection.Address
End Sub

Vấn đề là thế nào là ô cuối: ' Range1 = Union(Range("A2:A13"), [C1: D9])
Dùng vòng Do While để tính ô cuối

 

[NghiaKieu]

Sub Chon_o_cuoi()
  Sheets("Sheet1").Range("mang1").Select
  Selection(Selection.Rows.Count, Selection.Columns.Count).Select
End Sub

Em cảm ơn bác ạ. Code rất đúng ý em ạ.

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

Sub Chon_O_Cuoi()
    Sheets("Sheet1").Range("mang1").Select
    With Selection
        If .Columns.Count = 1 Then
            .Offset()(.Rows.Count).Select
        Else
            .Offset()(.Cells.Count).Select
        End If
        MsgBox Selection.Address
    End With
End Sub

Em cảm ơn bác ạ. Code rất đúng ý em ạ!

 

[Lequocvan]

Cho em hỏi tại sao với code sau:

Sub ThemNgayNghiLe2()
    Dim Parts() As String
    Dim Default
    Default = "01/31/2019,02/04/2019,02/05/2019,02/06/2019,02/07/2019,02/08/2019"
    On Error GoTo NoText
    Parts = Split(Replace(InputBox("Enter the values separated by commas", "List of HOLIDAY (mm/dd/yyyy)", Default, 10000, 1000), ", ", ","), ",")
    Range("A15:A30").Select
    With Selection
        .ClearContents
        .NumberFormat = "dd/mm/yyyy"
    End With
    With Range("A15").Resize(1 + UBound(Parts))
        .Cells = Application.Transpose(Parts)
    End With
NoText:
End Sub

Khi nhập giá trị ngày tháng theo kiểu dd/mm/yyyy vào inputbox thì khi ra sheet nó lại thành kiểu mm/dd/yyyy.
Có cách nào nhập trên inputbox dạng dd/mm/yyyy, ..., cách nhau dấu phẩy thì vào A15 của sheet theo kiểu dd/mm/yyyy ah?

 

[batman1]

Cho em hỏi tại sao với code sau:

Sub ThemNgayNghiLe2()
    Dim Parts() As String
    Dim Default
    Default = "01/31/2019,02/04/2019,02/05/2019,02/06/2019,02/07/2019,02/08/2019"
    On Error GoTo NoText
    Parts = Split(Replace(InputBox("Enter the values separated by commas", "List of HOLIDAY (mm/dd/yyyy)", Default, 10000, 1000), ", ", ","), ",")
    Range("A15:A30").Select
    With Selection
        .ClearContents
        .NumberFormat = "dd/mm/yyyy"
    End With
    With Range("A15").Resize(1 + UBound(Parts))
        .Cells = Application.Transpose(Parts)
    End With
NoText:
End Sub

Khi nhập giá trị ngày tháng theo kiểu dd/mm/yyyy vào inputbox thì khi ra sheet nó lại thành kiểu mm/dd/yyyy.
Có cách nào nhập trên inputbox dạng dd/mm/yyyy, ..., cách nhau dấu phẩy thì vào A15 của sheet theo kiểu dd/mm/yyyy ah?

Nhìn

Default = "01/31/2019,02/04/2019,02/05/2019,02/06/2019,02/07/2019,02/08/2019"
...
Parts = Split(Replace(InputBox("Enter the values separated by commas", "List of HOLIDAY (mm/dd/yyyy)", Default, 10000, 1000), ", ", ","), ",")

thì là bạn đang hướng dẫn người ta nhập theo dạng mm/dd/yyyy chứ đâu phải như bây giờ bạn viết là

Khi nhập giá trị ngày tháng theo kiểu dd/mm/yyyy vào inputbox

Vấn đề khác: khi bạn nhập tay trên sheet ngày tháng chuẩn thì sẽ hiển thị là mm/dd/yyyy hay dd/mm/yyyy. Nói cách khác, thiết lập trong CP là thế nào? Đừng bắt là dd/mm/yyyy hay mm/dd/yyyy. Chỉ nên bắt đúng theo thiết lập trong CP. Còn nó là cái này hay cái kia thì do CP quyết định.

 

[Lequocvan]

Tại em khó diễn đạt quá. Với code:

Sub ThemNgayNghiLe3()
    Dim Parts() As String
    Dim Default
    Default = "31/01/2019,04/02/2019,05/02/2019,06/02/2019,07/02/2019,08/02/2019"
    On Error GoTo NoText
    Parts = Split(Replace(InputBox("Enter the values separated by commas", "List of HOLIDAY", Default, 10000, 1000), ", ", ","), ",")
    Range("A15:A30").Select
    With Selection
        .ClearContents
        .NumberFormat = "dd/mm/yyyy"
    End With
    With Range("A15").Resize(1 + UBound(Parts))
        .Cells = Application.Transpose(Parts)
    End With
NoText:
End Sub

Thì với 31/01/2019 thì nó dạng text, còn lại thì dạng dd/mm/yyyy nhưng lại hiển thị kiểu mm/dd/yyyy ah

Còn khi vào nhập dữ liệu vào box kiểu tháng trước ngày sau thì kết quả ở sheet lại chuẩn kiểu dd/mm/yyyy. Mà em thì muốn kiểu VN.

 

[batman1]

Thôi tôi cũng không đi sâu vào vấn đề nữa.
Bạn thử sửa thành

.NumberFormat = "m/d/yyyy"

thì kết quả test sẽ thế nào?