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]

HieuCD · 28/3/21

Pi-Pikachu đã viết:
Chào các bạn,mình có lưu các file có đuôi txt trong một thư mục,với tên các file được lưu với quy định là: "tên file-" & thời điểm lưu file (yymmdd hhmmss)
ví dụ:
ABC-210327 230612.txt
AAB-210327 230120.txt
Các bạn giúp mình code vba lấy tên file có thời điểm lưu mới nhất với đó là: ABC-210327 230612.txt

Xem ví dụ

Mã:

  Dim maxFile$, maxTime, tFile, tmp
  '....
  'tFile = gì gì dó
  tFile = "ABC-040302 230612.txt" ' Vi du
  tmp = Split(Split(tFile, "-")(1), ".")(0)
  tmp = DateValue("20" & Mid(tmp, 1, 2) & "/" & Mid(tmp, 3, 2) & "/" & Mid(tmp, 5, 2)) _
          + TimeValue(Mid(tmp, 8, 2) & ":" & Mid(tmp, 10, 2) & ":" & Mid(tmp, 12, 2))
  If maxTime < tmp Then
    maxTime = tmp
    maxFile = tFile
  End If
  '...

Pi-Pikachu · 28/3/21

HieuCD đã viết:

Xem ví dụ

Mã:

  Dim maxFile$, maxTime, tFile, tmp
  '....
  'tFile = gì gì dó
  tFile = "ABC-040302 230612.txt" ' Vi du
  tmp = Split(Split(tFile, "-")(1), ".")(0)
  tmp = DateValue("20" & Mid(tmp, 1, 2) & "/" & Mid(tmp, 3, 2) & "/" & Mid(tmp, 5, 2)) _
          + TimeValue(Mid(tmp, 8, 2) & ":" & Mid(tmp, 10, 2) & ":" & Mid(tmp, 12, 2))
  If maxTime < tmp Then
    maxTime = tmp
    maxFile = tFile
  End If
  '...

Cảm ơn bạn đã giúp, sao code không có vòng lặp nào thế bạn? Có thể do mình chưa mô tả kỹ, ý mình là code sẽ thực hiện:
1) Tìm và lấy tất cả các tên file trong thư mục theo đường dẫn cụ thể ví dụ: D:\Data\
2) Sau khi tìm được thì kiểm tra xem file nào mới nhất rồi chọn file đó, ví dụ tìm được 2 file thì chọn 1 file mới nhất.

HieuCD · 28/3/21

Pi-Pikachu đã viết:
Cảm ơn bạn đã giúp, sao code không có vòng lặp nào thế bạn? Có thể do mình chưa mô tả kỹ, ý mình là code sẽ thực hiện:
1) Tìm và lấy tất cả các tên file trong thư mục theo đường dẫn cụ thể ví dụ: D:\Data\
2) Sau khi tìm được thì kiểm tra xem file nào mới nhất rồi chọn file đó, ví dụ tìm được 2 file thì chọn 1 file mới nhất.

Chổ ... bạn tự viết được mờ

Pi-Pikachu · 28/3/21

Buồn buồn như con chuồn chuồn.

Thanh Bình PV · 12/4/21

Cho em hỏi là em có 1 Form và 1 Button. Em mở Form sau đó nhấn Button sẽ ẩn Form đi và hiện InputBox để chọn ô..
Nhưng khi ẩn Form và hiện InputBox thì em phải click vào hộp thoại InputBox mới chọn ô được. Bình thường thì khi em gọi InputBox lên và chọn ô là được.
Bác nào giúp em với ạ. Em cảm ơn.

huongmuine · 12/4/21

Mình sử dụng code của bạn trên diễn đàn để tô màu vùng dữ liệu K4:O55. Tuy nhiên nó tô màu không đúng vùng dữ liệu mình muốn (K4:O6548).
Mong các bạn chỉ lỗi sai giúp.
Cảm ơn rất nhiều.

Quang_Hải · 12/4/21

huongmuine đã viết:
Mình sử dụng code của bạn trên diễn đàn để tô màu vùng dữ liệu K4:O55. Tuy nhiên nó tô màu không đúng vùng dữ liệu mình muốn (K4:O6548).
Mong các bạn chỉ lỗi sai giúp.
Cảm ơn rất nhiều.

Thay chỗ K4:O55 sẽ quyết định vùng cần hightlight khi thay đổi ô hiện hành

Mã:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([K4:O55], Target) Is Nothing Then
    ToMau [K4:O55], 44, 3 '<--- doi so nay tu 1 den 4 de cho ra 4 kieu HighLight
  End If
End Sub

huhumalu · 12/4/21

Thanh Bình PV đã viết:
Cho em hỏi là em có 1 Form và 1 Button. Em mở Form sau đó nhấn Button sẽ ẩn Form đi và hiện InputBox để chọn ô..
Nhưng khi ẩn Form và hiện InputBox thì em phải click vào hộp thoại InputBox mới chọn ô được. Bình thường thì khi em gọi InputBox lên và chọn ô là được.
Bác nào giúp em với ạ. Em cảm ơn.

Ủa xài vẫn bình thường.

huongmuine · 12/4/21

Quang_Hải đã viết:
Thay chỗ K4:O55 sẽ quyết định vùng cần hightlight khi thay đổi ô hiện hành

Mã:

Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect([K4:O55], Target) Is Nothing Then ToMau [K4:O55], 44, 3 '<--- doi so nay tu 1 den 4 de cho ra 4 kieu HighLight End If End Sub

Cảm ơn Bạn đã giúp. Code Bạn trích dẫn là code dùng tô màu dòng và cột khi di chuyển chuột.
Nhờ Bạn xem giúp mình code thứ 2 với ( dùng để tô màu theo điều kiện mong muốn ).

Thanh Bình PV · 12/4/21

huhumalu đã viết:
Ủa xài vẫn bình thường.

Lỗi của em là sau khi nhấn vào Button (Get) thì ẩn form và hiện cái InputBox lên.. Nhưng em phải click vào hộp thoại InputBox mới chọn ô được.. Bình thường thì khi hộp thoại InputBox hiện lên thì mình chỉ chọn ô thôi..
Không biết máy bác có bị vậy không chớ máy e là bị như vậy.

huhumalu · 12/4/21

Thanh Bình PV đã viết:
Lỗi của em là sau khi nhấn vào Button (Get) thì ẩn form và hiện cái InputBox lên.. Nhưng em phải click vào hộp thoại InputBox mới chọn ô được.. Bình thường thì khi hộp thoại InputBox hiện lên thì mình chỉ chọn ô thôi..
Không biết máy bác có bị vậy không chớ máy e là bị như vậy.

Do GPE kg chạy .gif
Mình kg làm gì cả, chỉ bật lên và dùng, kg phải click cái hộp thoại inputbox làm gì cả.

Thanh Bình PV · 12/4/21

huhumalu đã viết:
Do GPE kg chạy .gif
Mình kg làm gì cả, chỉ bật lên và dùng, kg phải click cái hộp thoại inputbox làm gì cả.

À.. Em thử bên máy ảo thì lại chạy tốt.. Mà máy tính em thì cứ nhấn button thì chớp 1 phát là phải click vào hộp thoại InputBox

((.. Không biết tại sao.

nghiank09 · 12/4/21

Chào mọi người, xin mọi người hỗ trợ đoạn code để cuộn chuột (cuộn chầm chậm - nhằm để tăng hoặc giảm âm lượng của ứng dụng không đột ngột). Giả sử ứng dụng đó là VLC Media Player, đang ở cửa sổ thứ nhất (hot key Windows + 1).Mình xin cám ơn ạ.

huongmuine · 15/4/21

Nhờ các bạn giúp gộp code thứ 2 và thứ 3 thành code sự kiện Worksheet_Change.
Cảm ơn.

SA_DQ · 15/4/21

Bạn thử cái ni xem có đúng ý bạn không nha:

PHP:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim MyColor As Long
  If Not Intersect([A3:V55], Target) Is Nothing Then
    MyColor = 34 + Rnd() * 9 \ 1
    ToMau [A3:V55],  MyColor, 3 '<--- doi so nay tu 1 den 4 de cho ra 4 kieu HighLight
  End If 
End Sub

huongmuine · 15/4/21

SA_DQ đã viết:
Bạn thử cái ni xem có đúng ý bạn không nha:

PHP:

Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim MyColor As Long If Not Intersect([A3:V55], Target) Is Nothing Then MyColor = 34 + Rnd() * 9 \ 1 ToMau [A3:V55], MyColor, 3 '<--- doi so nay tu 1 den 4 de cho ra 4 kieu HighLight End If End Sub

Cảm ơn Bác SA_DQ nhiều; Kiểu highlight rất hay.

huongmuine · 15/4/21

SA_DQ đã viết:
Bạn thử cái ni xem có đúng ý bạn không nha:

PHP:

Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim MyColor As Long If Not Intersect([A3:V55], Target) Is Nothing Then MyColor = 34 + Rnd() * 9 \ 1 ToMau [A3:V55], MyColor, 3 '<--- doi so nay tu 1 den 4 de cho ra 4 kieu HighLight End If End Sub

Nhờ bác giúp ghép lại 2 code này cùng hoạt động theo sự kiện:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cll As Range, Rng As Range
With Sheets("BC")
Set Rng = .Range("K3:O" & .Cells(Rows.Count, "B").End(xlUp).Row)
Rng.Interior.Color = xlNone
For Each Cll In Rng
    Select Case Cll.Value
        Case "": Cll.Interior.Color = RGB(255, 255, 204)
        Case Is < 5: Cll.Interior.Color = RGB(153, 204, 255)
        Case "Y": Cll.Interior.Color = RGB(255, 102, 0)
        Case "K": Cll.Interior.Color = RGB(199, 192, 192)
        Case "G": Cll.Interior.Color = RGB(153, 204, 0)
    End Select
Next
End With
End Sub



Public Sub CongDiem()
Dim sArr(), dArr(), i As Long, R As Long
sArr = Range("B4", Range("B4").End(xlDown)).Resize(, 15).Value
R = UBound(sArr): ReDim dArr(1 To R, 1 To 2)
For i = 1 To R
    If sArr(i, 2) <> Empty Then
   
        dArr(i, 1) = IIf((sArr(i, 6) + sArr(i, 7) + sArr(i, 8) + sArr(i, 5)) / 2 < 5, (5 - ((sArr(i, 6) + sArr(i, 7) + sArr(i, 8) + sArr(i, 5))) / 2) * 2, "")
        dArr(i, 2) = Application.WorksheetFunction.Round((sArr(i, 6) + sArr(i, 7) + sArr(i, 8) + sArr(i, 5)) / 2, 0)
   End If
Next i
Range("J4:K100").Interior.Color = xlNone
Range("J4:K100").ClearContents
Range("J4").Resize(R, 2) = dArr
End Sub

Cảm ơn Bác.

SA_DQ · 16/4/21

Theo mình thấy thì 2 macro này hoàn toàn có 2 nhiệm vụ khác nhau mà; Thêm nữa, hình như macro dưới nên làm trước khi chạy macro đầu.
Vậy thì kết hợp hay không có cần thiết lắm không; mà chỉ thêm rầy rà hay phiền phức chực chờ(?)

huongmuine · 16/4/21

SA_DQ đã viết:
Theo mình thấy thì 2 macro này hoàn toàn có 2 nhiệm vụ khác nhau mà; Thêm nữa, hình như macro dưới nên làm trước khi chạy macro đầu.
Vậy thì kết hợp hay không có cần thiết lắm không; mà chỉ thêm rầy rà hay phiền phức chực chờ(?)

Cảm ơn Bác SA_DQ đã góp ý.

TrungLeNB · 5/5/21

Chào mn,

Mình cũng biết mò qua chút VBA để làm việc cho tiện.
Mn cho hỏi khi mình sử dụng mảng giá trị lớn Vd:Arr(1000000,5) , thì khi chạy code lần thứ 2 mà ko đống file sẽ bị đầy bộ nhớ. Mình google để khắc phục thì thấy nên dùng thêm đoạn dưới để giải phóng bộ nhớ: Application.CutCopyMode = False
Mình ko hiểu lắm chức năng đoạn này, và có cần để lại nó là True khi đóng code k.

Code của mình:

Sub CONSOL_FILES()
Dim WbX As Workbook, WbY As Workbook
Dim ShX1 As Worksheet, ShX2 As Worksheet
Dim ShY1 As Worksheet, ShY2 As Worksheet, ShY3 As Worksheet
Dim Files As Variant
Dim i&, j&, TOTAL&, Lr&, x&, y&, RowData&
Dim ARR(999998, 12), FileName As String

Set WbX = ThisWorkbook
Set ShX1 = WbX.Sheets("Data")
Set ShX2 = WbX.Sheets("Ref")

Files = Application.GetOpenFilename(, , , , True)

If VarType(Files) = vbBoolean Then
Exit Sub 'Neu chon nut "Cancel
End If

TOTAL = UBound(Files) - LBound(Files) + 1

Application.ScreenUpdating = False
Application.EnableEvents = False

On Error GoTo LB01

RowData = 0

For i = LBound(Files) To UBound(Files)
Application.StatusBar = "Consoling..." & Round((j + 1) / TOTAL * 100, 0) & "%"
FileName = GetFileNameDB(Files(i))
If HasWorkbook(FileName) Then
Workbooks(FileName).Close True
End If

Set WbY = Workbooks.Open(Files(i), False)
Set ShY1 = WbY.Worksheets("Export Worksheet")

'CONSOL RAW DATA
For x = 2 To GetEndRow(ShY1, "A")
For y = 1 To 12

ARR(RowData, y - 1) = ShY1.Cells(x, y).Value

Next y
ARR(RowData, 12) = Left(FileName, 14)
RowData = RowData + 1
Next x

WbY.Close False

LB02:
j = j + 1

Next i

With ShX1.Range("A2:M999999")
.ClearContents
.Value = ARR
End With

LB01:

ConvertToText ShX1, "M"

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.StatusBar = ""
Application.CutCopyMode = False

MsgBox "DONE!"

End Sub

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

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

Chuyên gia GPE

Thành viên chính thức

Chuyên gia GPE

Thành viên chính thức

Thành viên hoạt động

File đính kèm

Thành viên GPE

File đính kèm

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

Thành viên tiêu biểu

File đính kèm

Thành viên GPE

Thành viên hoạt động

Thành viên tiêu biểu

Thành viên hoạt động

Thành viên hoạt động

Thành viên GPE

File đính kèm

/(hông là gì!

Thành viên GPE

Thành viên GPE

/(hông là gì!

File đính kèm

Thành viên GPE

Thành viên mới

Facebook

Group