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

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
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
Mình muốn i có thể bằng các giá trị từ 0 đến 10. Để mình có thể chọn được số dòng từ TDKQ theo ý mình để xuất sang PTKQ.
 

File đính kèm

Upvote 0
Hân Đỗ đã viết:
Mình muốn i có thể bằng các giá trị từ 0 đến 10. Để mình có thể chọn được số dòng từ TDKQ theo ý mình để xuất sang PTKQ.
Nhấp chuột vào đây để mở rộng...
Mình xem file của bạn rồi, nhưng chưa hiểu sheet PTKQ của bạn sao lại có hai bảng là sao, số dòng theo ý bạn là lấy những dòng nào từ sheet TDKQ rồi dán vào những dòng nào bên sheet PTKQ vậy.
 
Upvote 0
Bài #2947:
Bảng tính Excel 2007 trở lên có 1048576 dòng.
Khai báo integer sẽ bị lỗi over flow.
 
Upvote 0
Hân Đỗ đã viết:
Mình muốn i có thể bằng các giá trị từ 0 đến 10. Để mình có thể chọn được số dòng từ TDKQ theo ý mình để xuất sang PTKQ.
Nhấp chuột vào đây để mở rộng...
Bạn thử với macro sau & tự mình phát triển tiếp::
PHP: 
Sub dc()
Dim DongDau As Long, SoDong As Integer

DongDau = ActiveCell.Row
SoDong = InputBox("Sô Dòng Ban Cân: ", "GPE.COM", 9)

Range("A" & DongDau & ":AD" & DongDau + SoDong).Select
    Selection.Copy
 MsgBox Selection.Address    
'Sheets("PTKQ").Select
'    Range("A2:A6").Select
'ActiveSheet.Paste
'    Application.CutCopyMode = False
'   Sheets("PTKQ").Select
End Sub
 
Upvote 0
Hoàng Tuấn 868 đã viết:
Mình xem file của bạn rồi, nhưng chưa hiểu sheet PTKQ của bạn sao lại có hai bảng là sao, số dòng theo ý bạn là lấy những dòng nào từ sheet TDKQ rồi dán vào những dòng nào bên sheet PTKQ vậy.
Nhấp chuột vào đây để mở rộng...
minhg đã sửa được lỗi rồi. Cảm ơn bạn nhiều nha.:)
Bài đã được tự động gộp:

SA_DQ đã viết:
Bạn thử với macro sau & tự mình phát triển tiếp::
PHP: 
Sub dc()
Dim DongDau As Long, SoDong As Integer

DongDau = ActiveCell.Row
SoDong = InputBox("Sô Dòng Ban Cân: ", "GPE.COM", 9)

Range("A" & DongDau & ":AD" & DongDau + SoDong).Select
    Selection.Copy
MsgBox Selection.Address   
'Sheets("PTKQ").Select
'    Range("A2:A6").Select
'ActiveSheet.Paste
'    Application.CutCopyMode = False
'   Sheets("PTKQ").Select
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn
SA_DQ đã viết:
Bạn thử với macro sau & tự mình phát triển tiếp::
PHP: 
Sub dc()
Dim DongDau As Long, SoDong As Integer

DongDau = ActiveCell.Row
SoDong = InputBox("Sô Dòng Ban Cân: ", "GPE.COM", 9)

Range("A" & DongDau & ":AD" & DongDau + SoDong).Select
    Selection.Copy
MsgBox Selection.Address   
'Sheets("PTKQ").Select
'    Range("A2:A6").Select
'ActiveSheet.Paste
'    Application.CutCopyMode = False
'   Sheets("PTKQ").Select
End Sub
Nhấp chuột vào đây để mở rộng...
cảm ơn bạn, để mình thử dùng với mã code của bạn.
 
Upvote 0
Em thực hiện đoạn mã bị lỗi. Bác nào sửa giúp em với ạ
Runtime '-2147417851(80010105)'
method "Subject" of object"-Mailitem'Failed

em dùng office 2010




Sub Send_Files()

Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set sh = Sheets("Sheet1")

Set OutApp = CreateObject("Outlook.Application")

For Each cell In sh.Columns("C").Cells.SpecialCells(xlCellTypeConstants)
'thay cot C là cot chua dia chi mail

'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("D1:H1")

If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)

With OutMail
.to = cell.Value
.Subject = cell.Offset(0, -2) >>>>Lỗi

.Body = "hi" & cell.Offset(0, -1).Value

For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell

.Display
End With

Set OutMail = Nothing
End If
Next cell

Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
 
Upvote 0
Chào các bạn,mình đang gặp phải vấn đề sau với câu lệnh:
Mã: 
Sub AssistantAlert()
    With Application.Assistant
        Select Case _
            .DoAlert( _
            "Test", _
            "Click a button.", _
            msoAlertButtonYesAllNoCancel, _
            msoAlertIconCritical, _
            msoAlertDefaultSecond, _
            msoAlertCancelFirst, _
            False)
            Case vbYes: MsgBox "The user clicked Yes."
            Case vbNo: MsgBox "The user clicked No."
            Case vbCancel: MsgBox "The user clicked Cancel."
            Case 8: MsgBox "The user clicked Yes To All" 'This is the return value for YesToAll
            Case Else
        End Select
    End With
End Sub
Khi bấm nút close(dấu x) thì mặc định là yes, vậy làm thể nào để có thể mặc định là no hoặc cancel?
 
Upvote 0
Code gỡ pass trước khi chạy code
Tôi có 1 sheet Data lúc thì có pass sheet, lúc không có pass sheet
pass là sonthuy
Tôi muốn gỡ pass của Data để chạy code (nếu có)
Cảm ơn các bạn
 
Upvote 0
Mã: 
Private Sub cbDSNV_Change()
Dim Rng As Range, sRng As Range
Dim Rws As Long
Dim MyAdd As String, Ma As String, STT As String

Rws = [C2].CurrentRegion.Rows.Count
Set Rng = [C1].Resize(Rws)
Ma = Me!cbDSNV.Text & Me!tbMaNgay.Text
Set sRng = Rng.Find(Ma, , xlFormulas, xlPart)
If sRng Is Nothing Then
    Me!tbMaHD.Text = Ma & "000"
Else
    MyAdd = sRng.Address
    Do
        If Right(sRng.Value, 3) > STT Then STT = Right(sRng.Value, 3)
        Set sRng = Rng.FindNext(sRng)
    Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    Me!tbMaHD.Text = Ma & Right("00" & CStr(Int(STT) + 1), 3)
End If
End Sub
Code bài 11 https://www.giaiphapexcel.com/diend...tự-tự-động-trên-userform.154612/#post-1020391
Nhờ các anh chị em chú thích code trên giúp mình với. Xin cảm ơn.
 
Upvote 0
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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
  '...
 
Upvote 0
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
  '...
Nhấp chuột vào đây để mở rộng...
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.
 
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
Chổ ... bạn tự viết được mờ
 
Upvote 0
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.
 

File đính kèm

Upvote 0
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.
 

File đính kèm

Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
Ủa xài vẫn bình thường.
 

File đính kèm

  • Select.gif
    Select.gif
    57.1 KB · Đọc: 20
Lần chỉnh sửa cuối:
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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 ).
 
Upvote 0
huhumalu đã viết:
Ủa xài vẫn bình thường.
Nhấp chuột vào đây để mở rộ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.
 
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
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ả.
Select.gif
 
Lần chỉnh sửa cuối:
Upvote 0
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ả.
Nhấp chuột vào đây để mở rộng...
À.. 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.
 
Upvote 0
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 ạ.
 
Upvote 0
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.
 

File đính kèm

Upvote 0
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
 
Upvote 0
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ấp chuột vào đây để mở rộng...
Cảm ơn Bác SA_DQ nhiều; Kiểu highlight rất hay.
 
Upvote 0
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ấp chuột vào đây để mở rộng...
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.
 
Upvote 0
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ờ(?)
 

File đính kèm

  • CV13.jpg
    CV13.jpg
    54.4 KB · Đọc: 5
Upvote 0
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ờ(?)
Nhấp chuột vào đây để mở rộng...
Cảm ơn Bác SA_DQ đã góp ý.
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
TrungLeNB đã viết:
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:
Nhấp chuột vào đây để mở rộng...
Mấy dòng này chứ gì?
Application.ScreenUpdating = True => Để cập nhật lại màn hình sau khi chạy macro, tuy nhiên không có dòng này tôi thấy cũng không sao vì hết macro thì Excel cũng tự cập nhật kết quả lên màn hình máy tính.
Application.EnableEvents = True => Bật lại các sự kiện bảng tính. Nếu ở đầu có dòng Application.EnableEvents = False thì cuối buộc phải có dòng này.
Application.StatusBar = "" => Ở trên đã đặt StatusBar = gì gì đó rồi thì ở cuối phải set cho nó về = "" để khỏi thấy mãi cái thông tin kia (dù đã chạy xong macro rồi)
Application.CutCopyMode = False => Nếu trong lệnh có dòng Range(XX:YY).Copy thì cuối code cần có dòng này để hủy trạng thái vùng được copy có cái khung chạy chạy xung quanh. Không có cũng không sao nhưng hết macro thấy chạy chạy chướng mắt.

Vậy thôi, cả 4 dòng đều không có tác dụng trong việc giải phóng bộ nhớ.
 
Upvote 0
Maika8008 đã viết:
Mấy dòng này chứ gì?
Application.ScreenUpdating = True => Để cập nhật lại màn hình sau khi chạy macro, tuy nhiên không có dòng này tôi thấy cũng không sao vì hết macro thì Excel cũng tự cập nhật kết quả lên màn hình máy tính.
Application.EnableEvents = True => Bật lại các sự kiện bảng tính. Nếu ở đầu có dòng Application.EnableEvents = False thì cuối buộc phải có dòng này.
Application.StatusBar = "" => Ở trên đã đặt StatusBar = gì gì đó rồi thì ở cuối phải set cho nó về = "" để khỏi thấy mãi cái thông tin kia (dù đã chạy xong macro rồi)
Application.CutCopyMode = False => Nếu trong lệnh có dòng Range(XX:YY).Copy thì cuối code cần có dòng này để hủy trạng thái vùng được copy có cái khung chạy chạy xung quanh. Không có cũng không sao nhưng hết macro thấy chạy chạy chướng mắt.

Vậy thôi, cả 4 dòng đều không có tác dụng trong việc giải phóng bộ nhớ.
Nhấp chuột vào đây để mở rộng...
Thank bác. Mấy cái trên thì mình biết nhưng dòng Application.CutCopyMode = False giờ mới gặp.
Cho mình hỏi vậy làm như nào để giải phóng bộ nhớ khi mình chạy code có mảng dữ liệu lớn 2 lần.
 
Upvote 0
TrungLeNB đã viết:
Thank bác. Mấy cái trên thì mình biết nhưng dòng Application.CutCopyMode = False giờ mới gặp.
Cho mình hỏi vậy làm như nào để giải phóng bộ nhớ khi mình chạy code có mảng dữ liệu lớn 2 lần.
Nhấp chuột vào đây để mở rộng...
Mảng hay sheet, book đều tự hủy và giải phóng bộ nhớ sau khi xong macro nên không cần lệnh gì cả. Các đối tượng mà người ta thường hay set như Scripting.Dictionary hoặc FileSystemObject thì sẽ chiếm bộ nhớ nếu không giải phóng chúng bằng lệnh Set XXX = Nothing. Tuy nhiên bạn cũng nên Set XXX = Nothing cho tất cả các biến XXX nếu trước đó đã Set XXX = Gì đó.
 
Upvote 0
TrungLeNB đã viết:
Vd:Arr(1000000,5) ,
Nhấp chuột vào đây để mở rộng...
Dùng mảng to đùng như này mà không chủ động giải phỏng thì có lúc sẽ ăn Ram.
Dùng erase arr để giải phóng, mà khi khai báo là dim arr(10000000000,5) thì việc giải phóng có khi còn phản tác dụng

dim arr()
redim arr(1000000,5)

'code ahihihi ở đây

erase arr'giải phóng.



Ps:
Trong trường hợp này có khi dùng mảng động thì hợp lý hơn, không biết bác Vẹt với bác Rơi nghĩ sao vì cháu cũng chả hiểu rõ mấy cái cơ chế này.
Bài đã được tự động gộp:

Maika8008 đã viết:
Mảng hay sheet, book đều tự hủy và giải phóng bộ nhớ sau khi xong macro nên không cần lệnh gì cả
Nhấp chuột vào đây để mở rộng...
Trường hợp mảng nhỏ thì thằng VBa nó yêu thương chủ động giải phóng thì phải, mảng to quá nó không siêng như trước kia nữa thì phải,ahihi
 
Upvote 0
truongvu317 đã viết:
Ps:
Trong trường hợp này có khi dùng mảng động thì hợp lý hơn, không biết bác Vẹt với bác Rơi nghĩ sao vì cháu cũng chả hiểu rõ mấy cái cơ chế này.
Nhấp chuột vào đây để mở rộng...
Theo tôi ...

Với khai báo
Mã: 
Dim ARR(999998, 12)
thì trong không gian địa chỉ của process sẽ có một vùng ~ 208 MB được "đặt" cho nhu cầu của mảng Arr. Giá trị của vùng này có thể thay đổi trong suốt quá trình thực hiện process, nhưng độ lớn của nó luôn không đổi cho tới khi kết thúc process.
Với
Mã: 
Dim ARR
...
Redim ARR(1 To 999999, 1 To 13)
Thì biến ARR thực ra chỉ chứa địa chỉ của mảng ARR, tức đúng 4 bai trong system 32 bit. Khi chạy Sub thì mới có "đặt" một vùng trong memory ~ 208 MB, và địa chỉ của vùng đó được "ghi nhớ" trong biến ARR. Trước khi ra khỏi sub thì vùng được đặt sẽ được giải phóng.

Có thể tự "ép" giải phóng bộ nhớ - ERASE, nhưng:
- với Dim ARR(999998, 12) thì vùng ~ 208 MB trong memory được "xóa", tức nội dung của vùng đó, nhưng bản thân vùng ~ 208 MB vẫn luôn tồn tại trong memory.
- Với Dim ARR thì vùng được đặt cho ARR sẽ được giải phóng, 4 bai dành cho ARR để ghi nhớ vùng trong memory dành cho ARR sẽ được điền bằng những bai 0. Chỉ có vùng 4 bai là luôn luôn tồn tại suốt quá trình thực hiện process.

Cũng chỉ có lợi khi biến ARR là toàn cục - khi biến là toàn cục mà không dùng ERASE thì vùng chiếm bởi ARR sẽ tồn tại cho tới khi đóng tập tin. Vì thế nếu không dùng nữa thì trước khi ra khỏi sub nào đấy thì dùng ERASE để "ép" giải phóng bộ nhớ. Khi ARR là biến cục bộ thì trước khi ra khỏi Sub VBA sẽ tự giải phóng bộ nhớ.
 
Lần chỉnh sửa cuối:
Upvote 0
Cũng như chuỗi, mảng có hai dạng là dạng tĩnh và dạng động.

Dim a(1 To 100) as Integer là dạng khai báo tĩnh.
Khi đọc đến dòng này, trình dịch coi a là một mảng một chiều với 100 phần tử Integer. Và dạng này chết cứng luôn cho đến khi a không còn hiện hữu. Không thay đổi gì nữa cả. Trình dịch giành đủ chỗ chứa bấy nhiêu dữ liệu về mảng (mảng 1 chiều, chỉ số bắt đầu từ 1 đến 100, phần tử đầu tiên ở địa chỉ ***) và một dãy 200 bai để chứa các phần tử mảng (mỗi phần từ chiếm 2 bai). Lưu ý là bộ nhớ mà mảng dùng để chứa các phần tử phải liên tục, không được gián đoạn.
Nếu bạn dùng lệnh Erase a để xoá thì VBA chỉ xoá hết các trị của phần tử trong a thôi chứ a vẫn mãi mãi là một mảng Integer 100 phần tử, chiếm hữu bấy nhiêu trong bộ nhớ.
Chỉ khi a không còn hiện hữu, điển hình, exit/end Sub/Function khai báo nó thì trình dịch mới giải phóng bộ nhớ.

Dim a() as Integer là dạng khai báo động. Động ở đây nói về số phần tử và số chiều. Lưu ý rằng đoạn as integer xác định là mảng này chỉ chứa integers.
Khi đọc đến dòng này, trình dịch chỉ biết là bạn muốn một mảng ten a để chứa Integers. Nó chỉ giành riêng cho a của bạn cỡ một vài chục bai để chứa thông tin này.
Để có thẻ sử dụng a, bạn phải dùng một lệnh khác báo cho trình dịch cách giành bộ nhớ:
Redim a(1 To 10, 1 To 10) là lệnh xác định a.
Đọc đến dòng này, trình dịch sẽ giành thêm ra 200 bai để chứa 100 phần tử, và ghi vào chi tiết dữ liệu về a rằng: đây là một mảng 2 chiều, chiều 1 chỉ số 1 đến 10, chiều 2 chỉ số 1 đến 10, phần tử đầu tiên ở địa chỉ ***. Và vì đây là mảng, dù tĩnh hay động, trình dịch vẫn phải dùng một khoảng liên tục trong bộ nhớ cho dãy phần tử của a. Đó là lý do chính tại sao mảng lớn tốn nhiều bộ nhớ.
Mỗi lần bạn Redim (kể cả Redim Preserve) thì trình dịch lại tìm cho bạn một dãy bộ nhớ mới, và thảy bộ nhớ cũ trở vào cho ụ bộ nhớ (tức là giải phóng chỗ cũ này)
Khi bạn Erase a thì trình dịch chỉ phải giải phóng bộ nhớ cũ và không cần phải lấy mới cho a. Mảng a sẽ trở lại trạng thái giống như mới vừa được khai báo.

Như vậy, để làm nhẹ bộ nhớ, bạn có những lệnh căn bản sau:
- gán "" cho các biến string (nếu chúng dài qúa, ngắn thì chả bỏ công)
- Erase mảng động. Chỉ mảng động thôi, mảng tĩnh thì phải đợi ra khỏi tầm vực của biến.
- Set Nothing các Objects mà bạn dựng ra bằng lệnh CreateObject, hoặc lệnh New. Những đối tượng có sẵn của Excel luôn nằm đó, bạn chỉ ngưng con trỏ biến của mình vào chúng thôi. Việc set nothing này không chỉ quan trọng để giải phóng bộ nhớ mà còn giải phóng các tài nguyên khác tránh trường hợp bị khoá, bị rò bộ nhớ (ngày xưa ADO hay bị rò bộ nhớ nếu truy vấn trong cùng workbook cho nên người ta có thói quen set nothing ngay khi không còn dùng nữa, không đợi đến lúc end sub, biến ra khỏi tầm vực).
 
Upvote 0
Các anh chị cho mình hỏi với:
Mã: 
Dim Str
Str = Format(Abs(Number), "000000000000000000")
ý nghĩa "000000000000000000" ở đây là gì vậy. Nhờ các anh chị giải thích giúp mình với
 
Upvote 0
chisinhvnn đã viết:
Các anh chị cho mình hỏi với:
Mã: 
Dim Str
Str = Format(Abs(Number), "000000000000000000")
ý nghĩa "000000000000000000" ở đây là gì vậy. Nhờ các anh chị giải thích giúp mình với
Nhấp chuột vào đây để mở rộng...
Định dạng số với bằng ấy con số. Thí dụ Format(1234, "0000000") sẽ thành "0001234"
 
Upvote 0
Em chào A/C,
Em đang muốn lấy giá trị của ô Em đang nhập dữ liệu dở trong ô (em vẫn chưa chuyển con trỏ sang ô khác) thì code sẽ lấy giá trị vào ô B1 theo giá trị em đang nhập dở trong ô hiện hành.
VD: chữ Việt nam. Nếu em đang nhập vào ô hiện hành được chữ Việt -> Thì kết quả ô B1 sẽ hiện lên chữ Việt
Hiện tại Em đang viết code:
Range("B1").Value = Cells(Target.Row, Target.Column)
Code này phải nhập xong trong ô và chuyển sang ô khác thì giá trị nó mới lấy lên ô B1. Mong A/C giúp Em. Cảm ơn A/C nhiều!
 
Upvote 0
Love GPE đã viết:
Code này phải nhập xong trong ô và chuyển sang ô khác thì giá trị nó mới lấy lên ô B1. Mong A/C giúp Em. Cảm ơn A/C nhiều!
Nhấp chuột vào đây để mở rộng...
Bắt buộc phải vậy, Sheet Excel không có sự kiện changing, chỉ có sự kiện change. Textbox trong user form thì có
Với lại chỉ cần Range("B1").Value = Target.Value
 
Upvote 0
Gia đình mình cho em hỏi, Sự kiện Keydown trên Userform thì em biết làm, còn trên một ô thì mình viết thế nào anh chị nhỉ?
Ví dụ khi trỏ chuột tại ô A1, Em muốn khi bấm phím Enter (hoặc phím bất kỳ) thì nó sẽ chạy macro "Macro1".
Nhờ a chị chỉ giúp ạ!
 
Upvote 0
moihocvba đã viết:
Gia đình mình cho em hỏi, Sự kiện Keydown trên Userform thì em biết làm, còn trên một ô thì mình viết thế nào anh chị nhỉ?
Ví dụ khi trỏ chuột tại ô A1, Em muốn khi bấm phím Enter (hoặc phím bất kỳ) thì nó sẽ chạy macro "Macro1".
Nhờ a chị chỉ giúp ạ!
Nhấp chuột vào đây để mở rộng...
Làm được, và code rất là dài.
 
Upvote 0
moihocvba đã viết:
Gia đình mình cho em hỏi, Sự kiện Keydown trên Userform thì em biết làm, còn trên một ô thì mình viết thế nào anh chị nhỉ?
Ví dụ khi trỏ chuột tại ô A1, Em muốn khi bấm phím Enter (hoặc phím bất kỳ) thì nó sẽ chạy macro "Macro1".
Nhờ a chị chỉ giúp ạ!
Nhấp chuột vào đây để mở rộng...
Chỉ rồi thì có làm được hơm? Hay là anh chị viết luôn cho em chứ em "gà VBA lắm"
 
Upvote 0
Em chào A/C,
Em đang muốn xây dựng đoạn code cứ 15 giây thì code chạy sub DuLieu 1 lần (có nút bấm chạy và dừng).
Hiện tại Em mới mày mò ra được đoạn code nếu bấm vào thì sau 15 giây nó đã chạy. Nhưng sau đó nó chưa lặp lại được ạ. Đây là đoạn code của Em:
Sub CapNhatDuLieu()
Application.OnTime Now + TimeSerial(0, 0, 15), "DuLieu"
End Sub
Mong A/C giúp Em hoàn thiện tiếp đoạn code trên. Em cảm ơn A/C!
 
Upvote 0
hình như chưa điền đúng tên sub
Mã: 
Sub CapNhatDuLieu()
Application.OnTime Now + TimeSerial(0, 0, 15), "CapNhatDuLieu"
End Sub
 
Upvote 0
Love GPE đã viết:
Em chào A/C,
Em đang muốn xây dựng đoạn code cứ 15 giây thì code chạy sub DuLieu 1 lần (có nút bấm chạy và dừng).
Hiện tại Em mới mày mò ra được đoạn code nếu bấm vào thì sau 15 giây nó đã chạy. Nhưng sau đó nó chưa lặp lại được ạ. Đây là đoạn code của Em:
Sub CapNhatDuLieu()
Application.OnTime Now + TimeSerial(0, 0, 15), "DuLieu"
End Sub
Mong A/C giúp Em hoàn thiện tiếp đoạn code trên. Em cảm ơn A/C!
Nhấp chuột vào đây để mở rộng...
Như thế này mới được.
Mã: 
Sub CapNhatDuLieu()
       Application.OnTime Now + TimeSerial(0, 0, 15), " CapNhatDuLieu"
       Call DuLieu
End Sub
 
Upvote 0
giaiphap đã viết:
Như thế này mới được.
Mã: 
Sub CapNhatDuLieu()
       Application.OnTime Now + TimeSerial(0, 0, 15), " CapNhatDuLieu"
       Call DuLieu
End Sub
Nhấp chuột vào đây để mở rộng...
Em cảm ơn Anh, code chạy ngon lành Anh ạ.
Nếu Em tạo thêm 2 nút bấm "Cập nhật liên tục" và "Dừng" Anh và các bạn có thể giúp Em thêm code cho 2 nút bấm này được không ạ? Em cảm ơn nhiều!
 
Upvote 0
Love GPE đã viết:
Nếu Em tạo thêm 2 nút bấm "Cập nhật liên tục" và "Dừng" Anh và các bạn có thể giúp Em thêm code cho 2 nút bấm này được không ạ? Em cảm ơn nhiều!
Nhấp chuột vào đây để mở rộng...
1. Ở đầu module khai báo biến toàn cục
Mã: 
Private lastTime As Double


2. Sửa CapNhatDuLieu thành
Mã: 
Sub CapNhatDuLieu(ByVal start As Boolean)
    If start Then
        lastTime = Now + TimeSerial(0, 0, 15)
        Application.OnTime lastTime, "DuLieu"
    ElseIf lastTime <> 0 Then
        Application.OnTime lastTime, "DuLieu", , False
        lastTime = 0
    End If
End Sub

3. Trong sub DuLieu ở trước dòng End Sub hãy thêm dòng
Mã: 
CapNhatDuLieu True

4.
Khi muốn BẬT thì
Mã: 
CapNhatDuLieu True

Khi muốn TẮT thì
Mã: 
CapNhatDuLieu False
 
Upvote 0
batman1 đã viết:
1. Ở đầu module khai báo biến toàn cục
Mã: 
Private lastTime As Double


2. Sửa CapNhatDuLieu thành
Mã: 
Sub CapNhatDuLieu(ByVal start As Boolean)
    If start Then
        lastTime = Now + TimeSerial(0, 0, 15)
        Application.OnTime lastTime, "DuLieu"
    ElseIf lastTime <> 0 Then
        Application.OnTime lastTime, "DuLieu", , False
        lastTime = 0
    End If
End Sub

3. Trong sub DuLieu ở trước dòng End Sub hãy thêm dòng
Mã: 
CapNhatDuLieu True

4.
Khi muốn BẬT thì
Mã: 
CapNhatDuLieu True

Khi muốn TẮT thì
Mã: 
CapNhatDuLieu False
Nhấp chuột vào đây để mở rộng...
Tuyệt quá, Em làm theo code chạy như mong đợi rồi Anh ạ. Cảm ơn Anh và mọi người rất nhiều!
 
Upvote 0
batman1 đã viết:
1. Ở đầu module khai báo biến toàn cục
Mã: 
Private lastTime As Double


2. Sửa CapNhatDuLieu thành
Mã: 
Sub CapNhatDuLieu(ByVal start As Boolean)
    If start Then
        lastTime = Now + TimeSerial(0, 0, 15)
        Application.OnTime lastTime, "DuLieu"
    ElseIf lastTime <> 0 Then
        Application.OnTime lastTime, "DuLieu", , False
        lastTime = 0
    End If
End Sub

3. Trong sub DuLieu ở trước dòng End Sub hãy thêm dòng
Mã: 
CapNhatDuLieu True

4.
Khi muốn BẬT thì
Mã: 
CapNhatDuLieu True

Khi muốn TẮT thì
Mã: 
CapNhatDuLieu False
Nhấp chuột vào đây để mở rộng...

Em đang tập nghiên cứu code, nhân đoạn code này Em dịch như sau. Mong A/C xem và sửa giúp Em:
Mã: 
Sub CapNhatDuLieu(ByVal start As Boolean)    
    If start Then    
(Nếu biến start là True thì)

        lastTime = Now + TimeSerial(0, 0, 15)     
(Gán lastTime với lịch trình thời gian hiện tại + 15 giây)    
                                                                      
        Application.OnTime lastTime, "DuLieu"                 
(Chạy Sub DuLieu, sau 15 giây kể từ bây giờ)

    ElseIf lastTime <> 0 Then                 
(Ngược lại nếu lastTime <>0 thì... Chỗ này Em đang chưa hiểu lắm? Em có thử sửa lại: ElseIf Start=False Then  -> để theo cái if start = true ở trên. Thì code có chạy được. Em sửa như vậy thì có sao ko Anh nhỉ?)     
                                               
        Application.OnTime lastTime, "DuLieu", , False     
(Chạy Sub DuLieu, sau 15 giây kể từ bây giờ, , dừng thủ tục)       
                                                                                  
        lastTime = 0                                                           
(Khi dừng thủ tục thì gán lastTime =0 )

    End If
End Sub
 
Upvote 0
Love GPE đã viết:
Em đang tập nghiên cứu code, nhân đoạn code này Em dịch như sau. Mong A/C xem và sửa giúp Em:
Mã: 
Sub CapNhatDuLieu(ByVal start As Boolean)   
    If start Then   
(Nếu biến start là True thì)

        lastTime = Now + TimeSerial(0, 0, 15)    
(Gán lastTime với lịch trình thời gian hiện tại + 15 giây)   
                                                                     
        Application.OnTime lastTime, "DuLieu"                
(Chạy Sub DuLieu, sau 15 giây kể từ bây giờ)

    ElseIf lastTime <> 0 Then                
(Ngược lại nếu lastTime <>0 thì... Chỗ này Em đang chưa hiểu lắm? Em có thử sửa lại: ElseIf Start=False Then  -> để theo cái if start = true ở trên. Thì code có chạy được. Em sửa như vậy thì có sao ko Anh nhỉ?)    
                                              
        Application.OnTime lastTime, "DuLieu", , False    
(Chạy Sub DuLieu, sau 15 giây kể từ bây giờ, , dừng thủ tục)      
                                                                                 
        lastTime = 0                                                          
(Khi dừng thủ tục thì gán lastTime =0 )

    End If
End Sub
Nhấp chuột vào đây để mở rộng...
Đặt chỗ đó Start = False thì hóa ra true, false gì cũng chạy cả, bạn không thể dừng code được.
 
Upvote 0
Love GPE đã viết:
ElseIf lastTime <> 0 Then
(Ngược lại nếu lastTime <>0 thì... Chỗ này Em đang chưa hiểu lắm? Em có thử sửa lại: ElseIf Start=False Then -> để theo cái if start = true ở trên. Thì code có chạy được. Em sửa như vậy thì có sao ko Anh nhỉ?)

Application.OnTime lastTime, "DuLieu", , False
(Chạy Sub DuLieu, sau 15 giây kể từ bây giờ, , dừng thủ tục)

lastTime = 0
(Khi dừng thủ tục thì gán lastTime =0 )

End If
End Sub
[/CODE]
Nhấp chuột vào đây để mở rộng...
Không phải. Nếu start = True thì dĩ nhiên nhánh IF được thực hiện, tức vd. Application.OnTime lastTime, "DuLieu"
Vậy nếu đã xét tới ELSE ... thì ắt hẳn start = False rồi, khỏi phải kiểm tra nữa, tức không phải là ELSEIF start = False, vì cái điều kiện này (start = False) dĩ nhiên là thỏa.

Tại sao tôi kiểm tra điều kiện lastTime? Dụng ý là gì?

Giả sử không có ELSEIF lastTime <> 0, mà chỉ có ELSE.

Lúc đó code nhánh ELSE sẽ được thực hiện bất kể lastTime = 0 hay lastTime <> 0.

Giả sử bạn có code TẮT, được gán cho nút "Tắt đồng hồ".
Mã: 
CapNhatDuLieu False
Khi người dùng mở tập tin rồi lỡ nhân nút "Tắt đồng hồ", hoặc họ cố tình "phá hoại" thì sẽ xuất hiện LỖI vì ở thời điểm đó lastTime = 0. Vì thế tôi viết ELSEIF lastTime <> 0 để trong tình huống này thì điều kiện lastTie <> 0 KHÔNG THỎA để code không được thực hiện.

Bạn nên nhớ là trong cấu trúc IF ... không chỉ 1 điều kiện được kiểm tra mà có thể RẤT NHIỀU
Mã: 
If lt = "Vân Anh" then    ' lớp trưởng
...
ElseIf lp = "Diễm My" then    ' lớp phó
...
ElseIf cgcn = "Tuyết Mai" then    ' cô giáo chủ nhiệm
...
Else
...
End If

Vì thế tôi kiểm tra 2 điều kiện start và lastTime <> 0 là quá khiêm tốn, không có gì là khó hiểu cả.
 
Lần chỉnh sửa cuối:
Upvote 0
Maika8008 đã viết:
Đặt chỗ đó Start = False thì hóa ra true, false gì cũng chạy cả, bạn không thể dừng code được.
Nhấp chuột vào đây để mở rộng...
Sao lại không? Nếu sửa thế thì chỉ là thừa vì chắc chắn lúc này start = False rồi, khỏi cần kiểm tra. Mà đã thỏa Else thì
Application.OnTime lastTime, "DuLieu", , False

được thực hiện, tức là dừng đồng hồ. Chỉ có điều nếu bỏ lastTime <> 0 mà lỡ nhấn TẮT khi đồng hồ đang chưa chạy (đã được tắt), tức khi lastTime = 0, thì sẽ có LỖI. Vì
Mã: 
Application.OnTime lastTime, "DuLieu", , False
sẽ có lỗi khi lastTime = 0.

Khi viết code tôi luôn phục vụ các tình huống khi người dùng mệt mỏi và có thể nhầm lẫn, khi người dùng sơ ý hoặc cố ý ... Người ta nói là phải viết code sao cho nó chịu được lửa, chịu được nước, và chịu được cả những ngu dốt của người dùng.

Nhớ xem cả bài 3009
 
Upvote 0
batman1 đã viết:
Sao lại không? Nếu sửa thế thì chỉ là thừa vì chắc chắn lúc này start = False rồi, khỏi cần kiểm tra. Mà đã thỏa Else thì
Application.OnTime lastTime, "DuLieu", , False

được thực hiện, tức là dừng đồng hồ. Chỉ có điều nếu bỏ lastTime <> 0 mà lỡ nhấn TẮT khi đồng hồ đang chưa chạy (đã được tắt), tức khi lastTime = 0, thì sẽ có LỖI. Vì
Mã: 
Application.OnTime lastTime, "DuLieu", , False
sẽ có lỗi khi lastTime = 0.

Khi viết code tôi luôn phục vụ các tình huống khi người dùng mệt mỏi và có thể nhầm lẫn, khi người dùng sơ ý hoặc cố ý ... Người ta nói là phải viết code sao cho nó chịu được lửa, chịu được nước, và chịu được cả những ngu dốt của người dùng.

Nhớ xem cả bài 3009
Nhấp chuột vào đây để mở rộng...
Em cảm ơn Anh batman1 rất nhiều!
- Em có thử sửa code theo hướng lúc trước Em đang nhầm giữa Elseif và Else, thì khi bấm dừng với thủ tục "CapNhatDuLieu False" nếu bấm liên tục 2 lần thì code báo lỗi.
- Với code của Anh đã lường trước các trường hợp nên code ko bị lỗi gì cả.


Em ngồi mày mò tìm hiểu về thủ tục hủy, phương thức Application.OnTime. Nhưng nhìn code mãi vẫn chưa tư duy ra được hết ý nghĩa 3 dòng code này:
Mã: 
    ElseIf lastTime <> 0 Then    'Nếu lastTime <>0 thì
        Application.OnTime lastTime, "DuLieu", , False      'Schedule:=False dừng lịch trình. Em đang chưa hiểu điều kiện gì để False?
        lastTime = 0              'Gán lastTime=0
 
Upvote 0
Love GPE đã viết:
Em ngồi mày mò tìm hiểu về thủ tục hủy, phương thức Application.OnTime. Nhưng nhìn code mãi vẫn chưa tư duy ra được hết ý nghĩa 3 dòng code này:
Mã: 
    ElseIf lastTime <> 0 Then    'Nếu lastTime <>0 thì
        Application.OnTime lastTime, "DuLieu", , False      'Schedule:=False dừng lịch trình. Em đang chưa hiểu điều kiện gì để False?
        lastTime = 0              'Gán lastTime=0
Nhấp chuột vào đây để mở rộng...
Muốn tắt đồng hồ thì bắt buộc Schedule:=False. Vì thế trong code có False.

Còn tại sao thiết lập lastTime = 0?

Nếu bạn bấm liên tục 2 lần (vd. lỡ tay) thì:
- lần nhấn 1 sẽ tắt đồng hồ và thiết lập lastTime = 0
- ở lần bấm 2 thì điều kiện lastTime <> 0 không thỏa (đang có lastTime = 0 do lần 1 thiết lập), vậy code
Mã: 
Application.OnTime lastTime, "DuLieu", , False
sẽ không được thực hiện. Và chính xác phải là thế. Không táy máy nghịch TẮT cái đồng hồ đang được TẮT.
 
Upvote 0
batman1 đã viết:
Muốn tắt đồng hồ thì bắt buộc Schedule:=False. Vì thế trong code có False.

Còn tại sao thiết lập lastTime = 0?

Nếu bạn bấm liên tục 2 lần (vd. lỡ tay) thì:
- lần nhấn 1 sẽ tắt đồng hồ và thiết lập lastTime = 0
- ở lần bấm 2 thì điều kiện lastTime <> 0 không thỏa (đang có lastTime = 0 do lần 1 thiết lập), vậy code
Mã: 
Application.OnTime lastTime, "DuLieu", , False
sẽ không được thực hiện. Và chính xác phải là thế. Không táy máy nghịch TẮT cái đồng hồ đang được TẮT.
Nhấp chuột vào đây để mở rộng...
Dạ vâng Em cảm ơn Anh!
 
Upvote 0
Em chào A/C!
Em có đoạn code dưới đây đang lấy giá trị của các hiện hành khi bấm vào.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Sheet1.Range("A1").Value = Selection.Value
End Sub

Em muốn nhờ A/C giúp Em sửa code chỗ ( = Selection.Value ) để code lấy giá trị của dòng 2 theo từng cột.
VD: Em có bảng dữ liệu với tiêu đề ở dòng số 2:
A2: Mặt hàng
B2: Kho hàng

Nếu Em đặt chuột ở bất kỳ vị trí nào ở cột A thì code đều lấy giá trị trả về là giá trị của ô A2 là "Mặt hàng", ở bất kỳ vị trí nào trong cột B thì code cũng trả về giá trị ô B 2 là "Kho hàng". Mong A/C giúp Em. Cảm ơn A/C nhiều!
 
Upvote 0
Love GPE đã viết:
Em chào A/C!
Em có đoạn code dưới đây đang lấy giá trị của các hiện hành khi bấm vào.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Sheet1.Range("A1").Value = Selection.Value
End Sub

Em muốn nhờ A/C giúp Em sửa code chỗ ( = Selection.Value ) để code lấy giá trị của dòng 2 theo từng cột.
VD: Em có bảng dữ liệu với tiêu đề ở dòng số 2:
A2: Mặt hàng
B2: Kho hàng

Nếu Em đặt chuột ở bất kỳ vị trí nào ở cột A thì code đều lấy giá trị trả về là giá trị của ô A2 là "Mặt hàng", ở bất kỳ vị trí nào trong cột B thì code cũng trả về giá trị ô B 2 là "Kho hàng". Mong A/C giúp Em. Cảm ơn A/C nhiều!
Nhấp chuột vào đây để mở rộng...
Dùng tạm
Sheet1.Range("A1").Value =cells(2, Selection.column).Value
 
Upvote 0
chào anh chị
em muốn hạn chế thời gian nhập nội dung vào 1 ô trên excel có được không ạ. Ví dụ như nội dung ngày 21/10 thì đến ngày 22 không thế nhập vào ô đó nữa ạ
em cảm ơn ạ
 
Upvote 0
Chào moị người
mình có chạy cái file để tách thành các sheet từ 1 sheet code :
Sub locdulieu()
'coppy du lieu
shtam.Range("A:A").Value = data.Range("C:C").Value
shtam.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
Columns("A:A").Select
Selection.Replace What:="/", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Dim lr As Long, i As Long, lrdata As Long
lr = shtam.Range("A" & Rows.Count).End(xlUp).Row
lrdata = data.Range("H" & Rows.Count).End(xlUp).Row
For i = 2 To lr
data.Range("$A$1:$H" & lrdata).AutoFilter Field:=3, Criteria1:=shtam.Cells(i, 1).Value
data.Range("$A$1:$H" & lrdata).Copy 'coppy du lieu da loc
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = shtam.Cells(i, 1).Value 'doi ten sheet thanh ten khach hang
ActiveSheet.Range("A1").PasteSpecial xlPasteValues

Next i

End Sub
Vì name có dấu / nên khi tới 4 sheet là nó báo lỗi , có cách nào khắc phục được không ạ , mình đã thử xóa dấu / nhưng chạy file vẫn bị lỗi , vì người mới nên nhờ mọi người hỗ trợ giúp ạ .
cảm ơn mọi người
 

File đính kèm

Upvote 0
Dennisphan94 đã viết:
Mã: 
Sub ABC()
    Dim Arr(), iR&, ws As Worksheet
    Dim dic As Object, S, X
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set dic = CreateObject("scripting.dictionary")
For Each ws In Worksheets
    If ws.Name <> "data" Then
        ws.Delete
    End If
Next
With Sheets("data")
    If .AutoFilterMode Then .AutoFilterMode = False
    Arr = .Range("C2:C" & .Range("C" & Rows.Count).End(3).Row).Value
End With
For i = 1 To UBound(Arr, 1)
    If dic.exists(Arr(i, 1)) = False Then
        dic.Add (Arr(i, 1)), ""
    End If
Next
iR = Sheets("data").Range("C" & Rows.Count).End(3).Row
For Each S In dic.keys
    With Sheets("data")
        Worksheets.Add after:=Worksheets(Worksheets.Count)
        .Range("$A$1:$H" & iR).AutoFilter 3, S
        .Range("$A$1:$H" & iR).Copy ActiveSheet.Range("A1")
        S = Replace(S, "/", "-")
        ActiveSheet.Name = Right(S, Len(S) - 7)
    End With
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Vì name có dấu / nên khi tới 4 sheet là nó báo lỗi , có cách nào khắc phục được không ạ , mình đã thử xóa dấu / nhưng chạy file vẫn bị lỗi , vì người mới nên nhờ mọi người hỗ trợ giúp ạ .
cảm ơn mọi người
Nhấp chuột vào đây để mở rộng...
Tên sheet không được đặt chuỗi quá 31 kí tự
Ban thử dùng code này. Xóa tất cả sheet đi. để lại sheet data thôi
 
Lần chỉnh sửa cuối:
Upvote 0
Hi bạn
mình có thể đặt tên sheet đó + với sô lượng dòng trong sheet đó dc ko bạn / ví dụ ( Buu Long LM Hub 1998 đơn )
Bài đã được tự động gộp:

Hi bạn
mình có thể đặt tên sheet đó + với sô lượng dòng trong sheet đó dc ko bạn / ví dụ ( Buu Long LM Hub 1998 đơn )
 
Lần chỉnh sửa cuối:
Upvote 0
Dennisphan94 đã viết:
Hi bạn
mình có thể đặt tên sheet đó + với sô lượng dòng trong sheet đó dc ko bạn / ví dụ ( Buu Long LM Hub 1998 đơn )
Nhấp chuột vào đây để mở rộng...
Thứ nhất: Bạn đang muốn trao đổi với ai hay tác giả bài đăng nào trong ~ 3 ngàn bài đăng ở đây vậy?
Thứ 2: Tên Trang tính không nên chứa tiếng việt có dấu, mà cụ thể ở đây là 'Đ'
Thứ ba: Như bài trên gần đây có nói, tên trang tính không dài quá số ký tự nào đó (cho từng VER)
Vậy theo mình, ta hạn chế khoảng trắng trong tên (trang tính), vì dụ: Thay vì tên của ví dụ bạn, nên là "BuuLongLM_Hub1998Don"

Chúc mọi điều tốt lành đến tất cả mọi người.
 
Upvote 0
SA_DQ đã viết:
Thứ nhất: Bạn đang muốn trao đổi với ai hay tác giả bài đăng nào trong ~ 3 ngàn bài đăng ở đây vậy?
...
Nhấp chuột vào đây để mở rộng...
Bạn biết tiếng Tây hôn mà chỉnh người ta vậy.
Người ta đã "ráp po" và "hai" với tác giả bài #3020 mờ. -.,\;
 
Upvote 0
Em đang tìm hiểu về Dictionary, xin nhờ các anh, chị giúp em cách gán Item của Dic xuống Sheet
Ở trong file đính kèm tính tổng doanh số của nhân viên ở các sheet. Em đã thử mấy cách mà không gán xuống được (chuẩn là em không biết cách gán), và cho em hỏi với trường hợp như file của em cách áp dụng Dic như nào sẽ tối ưu hơn
Em xin cám ơn!
 

File đính kèm

Upvote 0
queluatb đã viết:
Em đang tìm hiểu về Dictionary, xin nhờ các anh, chị giúp em cách gán Item của Dic xuống Sheet
Ở trong file đính kèm tính tổng doanh số của nhân viên ở các sheet. Em đã thử mấy cách mà không gán xuống được (chuẩn là em không biết cách gán), và cho em hỏi với trường hợp như file của em cách áp dụng Dic như nào sẽ tối ưu hơn
Em xin cám ơn!
Nhấp chuột vào đây để mở rộng...
Gán bộ Item cho 1 mảng:
Arr = Dic.Items
Rồi chép mảng đó ra sheet
Range("A2").Resize(1, Dic.Count) = Arr
 
Upvote 0
queluatb đã viết:
Em đang tìm hiểu về Dictionary, xin nhờ các anh, chị giúp em cách gán Item của Dic xuống Sheet
Ở trong file đính kèm tính tổng doanh số của nhân viên ở các sheet. Em đã thử mấy cách mà không gán xuống được (chuẩn là em không biết cách gán), và cho em hỏi với trường hợp như file của em cách áp dụng Dic như nào sẽ tối ưu hơn
Em xin cám ơn!
Nhấp chuột vào đây để mở rộng...
Nó ra giá trị bằng không là đúng rồi còn gì.Ở đây câu lệnh này.Dic.Item(1) là lấy giá trị của item với Key = 1.Mà trong trường hợp này key =1 là giá không có nên nó bằng không.Nên dùng mảng ghi theo dữ liệu của dic thì ổn hơn.
 
Upvote 0
queluatb đã viết:
tìm hiểu về Dictionary
Nhấp chuột vào đây để mở rộng...
Đọc ở đâu không biết. Tài liệu rõ ràng, đầy đủ, chi tiết ở đây này.

Bài minh họa lọc trùng và tính tổng có sẵn luôn.

www.giaiphapexcel.com

Bài 11. Dictionary

Bài 11. Dictionary (Danh sách các bài viết về VBA xem ở đây Index - Các bài viết về VBA) Dictionary (Dic) là một phần trong thư viện Microsoft Scripting Runtime (scrrun.dll), cho phép lưu trữ và truy xuất số lượng lớn Item theo Key duy nhất tương ứng. 1. Khai báo 1.1. Kiểu khai báo sớm (Có...
www.giaiphapexcel.com www.giaiphapexcel.com

---
Item là Array thì làm vậy sao được.
Mã: 
    For Each Sh In Worksheets
        If Sh.Name <> "TH" Then
            arr = Sh.Range("A2:C" & Sh.Cells(Rows.Count, "A").End(xlUp).Row).Value
            For i = 1 To UBound(arr, 1)
                If Not Dic.exists(CStr(arr(i, 1))) Then
                    Dic(CStr(arr(i, 1))) = Array(arr(i, 2), arr(i, 3))
                Else
                    Dic(CStr(arr(i, 1))) = Dic(CStr(arr(i, 1)))(1) + arr(i, 3)
                    'MsgBox Dic(CStr(arr(i, 1)))
                End If
            Next i
        End If
    Next Sh
    Worksheets("TH").Range("F1").Resize(Dic.Count, 3).ClearContents
    Worksheets("TH").Range("F1").Resize(Dic.Count, 1) = Application.Transpose(Dic.keys)
    Worksheets("TH").Range("G1").Resize(Dic.Count, 1) = Application.Transpose(Dic.Item(1))
 
Upvote 0
befaint đã viết:
Đọc ở đâu không biết. Tài liệu rõ ràng, đầy đủ, chi tiết ở đây này.

Bài minh họa lọc trùng và tính tổng có sẵn luôn.

www.giaiphapexcel.com

Bài 11. Dictionary

Bài 11. Dictionary (Danh sách các bài viết về VBA xem ở đây Index - Các bài viết về VBA) Dictionary (Dic) là một phần trong thư viện Microsoft Scripting Runtime (scrrun.dll), cho phép lưu trữ và truy xuất số lượng lớn Item theo Key duy nhất tương ứng. 1. Khai báo 1.1. Kiểu khai báo sớm (Có...
www.giaiphapexcel.com www.giaiphapexcel.com

---
Item là Array thì làm vậy sao được.
Mã: 
    For Each Sh In Worksheets
        If Sh.Name <> "TH" Then
            arr = Sh.Range("A2:C" & Sh.Cells(Rows.Count, "A").End(xlUp).Row).Value
            For i = 1 To UBound(arr, 1)
                If Not Dic.exists(CStr(arr(i, 1))) Then
                    Dic(CStr(arr(i, 1))) = Array(arr(i, 2), arr(i, 3))
                Else
                    Dic(CStr(arr(i, 1))) = Dic(CStr(arr(i, 1)))(1) + arr(i, 3)
                    'MsgBox Dic(CStr(arr(i, 1)))
                End If
            Next i
        End If
    Next Sh
    Worksheets("TH").Range("F1").Resize(Dic.Count, 3).ClearContents
    Worksheets("TH").Range("F1").Resize(Dic.Count, 1) = Application.Transpose(Dic.keys)
    Worksheets("TH").Range("G1").Resize(Dic.Count, 1) = Application.Transpose(Dic.Item(1))
Nhấp chuột vào đây để mở rộng...
về bài hướng dẫn ở link này em đã làm theo và làm được, tuy nhiên em đang tìm hiểu thêm lên muốn thử về Array của Dic, em xin cám ơn các anh đã giúp đỡ
 
Upvote 0
queluatb đã viết:
về bài hướng dẫn ở link này em đã làm theo và làm được, tuy nhiên em đang tìm hiểu thêm lên muốn thử về Array của Dic, em xin cám ơn các anh đã giúp đỡ
Nhấp chuột vào đây để mở rộng...
Trợt lớt hết trơn rồi còn thử mốc xì gì.
Dic là một collection, làm quái gì có array mà gọi "Array của Dic".
 
Upvote 0
Em chào các Thầy Cô và Anh Chị
Em có đoạn code này mà không biết làm thế nào để đưa nó vào vòng lặp cho nó ngắn lại
Nhờ mọi người có thể chỉ giúp em với ạ
Em xin cám ơn nhiều
Mã: 
     .Cells(r - 2, 12) = Empty
                .Cells(r - 1, 12) = Empty
                .Cells(r - 1, 6) = Empty
                .Cells(r, 7) = Empty
                .Cells(r + 1, 7) = Empty
                .Cells(r + 2, 7) = Empty
                .Cells(r + 3, 7) = Empty
                '----------------------
                .Cells(r - 2, 22) = Empty
                .Cells(r - 1, 22) = Empty
                .Cells(r - 1, 16) = Empty
                .Cells(r, 17) = Empty
                .Cells(r + 1, 17) = Empty
                .Cells(r + 2, 17) = Empty
                .Cells(r + 3, 17) = Empty
                '-----------------------
                .Cells(r + 4, 4) = Empty
                .Cells(r + 6, 4) = Empty
                .Cells(r + 8, 4) = Empty
                .Cells(r + 4, 9) = Empty
                .Cells(r + 6, 9) = Empty
                .Cells(r + 8, 9) = Empty
                '--------------------------
                .Cells(r + 4, 14) = Empty
                .Cells(r + 6, 14) = Empty
                .Cells(r + 8, 14) = Empty
                .Cells(r + 4, 19) = Empty
                .Cells(r + 6, 19) = Empty
                .Cells(r + 8, 19) = Empty
 
Upvote 0
.Cells(r + 4, 4) = Empty
.Cells(r + 6, 4) = Empty
.Cells(r + 8, 4) = Empty
.Cells(r + 4, 9) = Empty
.Cells(r + 6, 9) = Empty
.Cells(r + 8, 9) = Empty
'--------------------------
.Cells(r + 4, 14) = Empty
.Cells(r + 6, 14) = Empty
.Cells(r + 8, 14) = Empty
.Cells(r + 4, 19) = Empty
.Cells(r + 6, 19) = Empty
.Cells(r + 8, 19) = Empty

Dùng vòng lặp không phải chỉ để làm ngắn code. Đó là lối suy nghĩ của tay mơ.
Trong trường hợp code trên, thu vào vòng lặp sẽ cho thấy rõ hơn sự liên hệ giữa các cells đang làm việc, và sẽ dễ bảo trì code.

For r1 = r + 4 To r + 8 Step 2
For c1 = 4 To 19 Step 5
.Cells(r1, c1) = Empty
Next c1
Next r1
Mẹo đếm vòng lặp: vòng r1 có 3 lượt, vòng c1 có 4 lượt. 3x4 = 12 = số dòng trong code cũ. Vậy là code có nhiều hy vọng đúng.

Chú thích: code trên dùng cái With block dài quá, rất dễ bị sai sót, và rất khó cho việc copy/cut/paste thêm bớt code. Dùng thẳng tiền tố ShA, ShB, ... tốt hơn.
 
Upvote 0
VetMini đã viết:
.Cells(r + 4, 4) = Empty
.Cells(r + 6, 4) = Empty
.Cells(r + 8, 4) = Empty
.Cells(r + 4, 9) = Empty
.Cells(r + 6, 9) = Empty
.Cells(r + 8, 9) = Empty
'--------------------------
.Cells(r + 4, 14) = Empty
.Cells(r + 6, 14) = Empty
.Cells(r + 8, 14) = Empty
.Cells(r + 4, 19) = Empty
.Cells(r + 6, 19) = Empty
.Cells(r + 8, 19) = Empty

Dùng vòng lặp không phải chỉ để làm ngắn code. Đó là lối suy nghĩ của tay mơ.
Trong trường hợp code trên, thu vào vòng lặp sẽ cho thấy rõ hơn sự liên hệ giữa các cells đang làm việc, và sẽ dễ bảo trì code.

For r1 = r + 4 To r + 8 Step 2
For c1 = 4 To 19 Step 5
.Cells(r1, c1) = Empty
Next c1
Next r1
Mẹo đếm vòng lặp: vòng r1 có 3 lượt, vòng c1 có 4 lượt. 3x4 = 12 = số dòng trong code cũ. Vậy là code có nhiều hy vọng đúng.

Chú thích: code trên dùng cái With block dài quá, rất dễ bị sai sót, và rất khó cho việc copy/cut/paste thêm bớt code. Dùng thẳng tiền tố ShA, ShB, ... tốt hơn.
Nhấp chuột vào đây để mở rộng...
Cám ơn chú rất nhiều. Tại viết code nó dài lê thê. Ngồi coi mãi mà không tìm ra điểm nào để đưa nó vào vòng lặp
Cho con hỏi. "Tay mơ" là thế nào chú?
Hihi. cám ơn chú rất nhiều. Để con thử ạ
------------------------------------------
Cám ơn chú đã gơi ý .
Ngồi test thấy nó ra bị thiếu. Quay lại đọc bài thì thấy chú ghi chú 1 nửa đoạn cho vào vòng lặp
Còn 1 nửa còn lại quên béng mất bảo sao thấy nó không xoá hết.
Cho con hỏi thêm chút nữa ạ. Nếu thao tác empty thế kia thì cũng có thể dùng Cleacontents những vùng được xác định phải không chú?
 
Lần chỉnh sửa cuối:
Upvote 0
VetMini đã viết:
Mẹo đếm vòng lặp: vòng r1 có 3 lượt, vòng c1 có 4 lượt. 3x4 = 12 = số dòng trong code cũ. Vậy là code có nhiều hy vọng đúng.
Nhấp chuột vào đây để mở rộng...
Cảm ơn chú 1 lần nữa. Sau khi ngồi đọc code của chú. Cũng tìm ra cách đưa nó vào vòng lặp
Nhưng có vẻ số dòng code cũng không ngắn hơn là bao. Hihi
Tương lai sau khi phát sinh sự cố chắc ngồi đọc lại chẳng hiểu tại sao đặt biết kiểu ấy mất.
Mã: 
                For r1 = r - 2 To r - 1 Step 1
                    For c1 = 12 To 22 Step 10
                        .Cells(r1, c1) = Empty
                    Next
                Next
                For c1 = 6 To 16 Step 10
                    .Cells(r - 1, c1) = Empty
                Next
                For r1 = r To r + 3
                    For c1 = 7 To 17 Step 10
                        .Cells(r1, c1) = Empty
                    Next
                Next
                For r1 = r + 4 To r + 8 Step 2
                    For c1 = 4 To 19 Step 5
                        .Cells(r1, c1) = Empty
                    Next c1
                Next r1
Chắc cứ viết tường minh ra có lẽ tránh hậu hoạ sau này đọc không hiểu mất.
Xin cám ơn chú nhiều ạ
 
Upvote 0
BuiQuangThuan đã viết:
Cám ơn chú rất nhiều. Tại viết code nó dài lê thê. Ngồi coi mãi mà không tìm ra điểm nào để đưa nó vào vòng lặp
Cho con hỏi. "Tay mơ" là thế nào chú?
Hihi. cám ơn chú rất nhiều. Để con thử ạ
Nhấp chuột vào đây để mở rộng...
"Tay mơ" sẽ cố gắng nhét chúng hết vào một block vòng lặp. Nhưng không có khái niệm "nhóm" chúng theo loại dòng cho nên sẽ bí.

Đây là code 1 block. Dùng Union để nhóm:
For r1 = r - 2 To r + 8
Select Case r1 - r
Case -2
Union(.Cells(r1, 12), .Cells(r1 - 2, 22)) = Empty
Case -1
Union(.Cells(r1, 12), .Cells(r1, 22), .Cells(r1, 6), .Cells(r1, 16)) = Empty
Case 0 To 3
Union(.Cells(r1, 7), .Cells(r1, 17)) = Empty
Case 4, 6, 8
Union(.Cells(r1, 4), .Cells(r1, 9), .Cells(r1, 14), .Cells(r1, 19)) = Empty
End Select
Next r1
 
Lần chỉnh sửa cuối:
Upvote 0
VetMini đã viết:
"Tay mơ" sẽ cố gắng nhét chúng hết vào một block vòng lặp. Nhưng không có khái niệm "nhóm" chúng theo loại dòng cho nên sẽ bí.

Đây là code 1 block. Dùng Union để nhóm:
For r1 = r - 2 To r + 8
Select Case r1
Case r - 2
Union(.Cells(r1, 12), .Cells(r1 - 2, 22)) = Empty
Case r - 1
Union(.Cells(r1, 12), .Cells(r1, 22), .Cells(r1, 6), .Cells(r1, 16)) = Empty
Case r To r+3
Union(.Cells(r1, 7), .Cells(r1, 17)) = Empty
Case 4, 6, 8
Union(.Cells(r1, 4), .Cells(r1, 9), .Cells(r1, 14), .Cells(r1, 19)) = Empty
End Select
Next r1
Nhấp chuột vào đây để mở rộng...
Cám ơn chú. Chắc kiểu này con viết rõ ràng ra cho lành mạnh. Chứ viết thế kia nếu đúng mà không hiểu được nó, không kiểm soát được nó, Chắc mai mốt có vấn đề gì đó chắc lại chữ thầy giả thầy. Thậm chí không biết là sai chỗ nào ế.
Cám ơn chú 1 lần nữa. Chắc chắn sẽ ngồi đọc cho vỡ lẽ cái đoạn kia ạ
 
Upvote 0
BuiQuangThuan đã viết:
Em chào các Thầy Cô và Anh Chị
Em có đoạn code này mà không biết làm thế nào để đưa nó vào vòng lặp cho nó ngắn lại
Nhờ mọi người có thể chỉ giúp em với ạ
Em xin cám ơn nhiều
Mã: 
     .Cells(r - 2, 12) = Empty
                .Cells(r - 1, 12) = Empty
                .Cells(r - 1, 6) = Empty
                .Cells(r, 7) = Empty
                .Cells(r + 1, 7) = Empty
                .Cells(r + 2, 7) = Empty
                .Cells(r + 3, 7) = Empty
                '----------------------
                .Cells(r - 2, 22) = Empty
                .Cells(r - 1, 22) = Empty
                .Cells(r - 1, 16) = Empty
                .Cells(r, 17) = Empty
                .Cells(r + 1, 17) = Empty
                .Cells(r + 2, 17) = Empty
                .Cells(r + 3, 17) = Empty
                '-----------------------
                .Cells(r + 4, 4) = Empty
                .Cells(r + 6, 4) = Empty
                .Cells(r + 8, 4) = Empty
                .Cells(r + 4, 9) = Empty
                .Cells(r + 6, 9) = Empty
                .Cells(r + 8, 9) = Empty
                '--------------------------
                .Cells(r + 4, 14) = Empty
                .Cells(r + 6, 14) = Empty
                .Cells(r + 8, 14) = Empty
                .Cells(r + 4, 19) = Empty
                .Cells(r + 6, 19) = Empty
                .Cells(r + 8, 19) = Empty
Nhấp chuột vào đây để mở rộng...
Dùng 2 mảng liệt kê dòng và cột
Mã: 
  Dim rng As Range, sRow, aCol, k&
  '....
  arow = Array(-2, -1, -1, 0, 1, 2, 3, -2, -1, -1, 0, 1, 2, 3, 4, 6, 8, 4, 6, 8, 6, 8, 4, 6, 8)
  aCol = Array(12, 12, 6, 7, 7, 7, 7, 22, 22, 16, 17, 17, 17, 17, 4, 4, 4, 9, 9, 9, 14, 14, 14, 19, 19, 19)
  Set rng = .Cells(r + arow(0), aCol(0))
  For k = 1 To UBound(arow)
    Set rng = Union(rng, .Cells(r + arow(k), aCol(k)))
  Next k
  rng = Empty
  Set rng = Nothing
 
Upvote 0
HieuCD đã viết:
Dùng 2 mảng liệt kê dòng và cột
Mã: 
  Dim rng As Range, sRow, aCol, k&
  '....
  arow = Array(-2, -1, -1, 0, 1, 2, 3, -2, -1, -1, 0, 1, 2, 3, 4, 6, 8, 4, 6, 8, 6, 8, 4, 6, 8)
  aCol = Array(12, 12, 6, 7, 7, 7, 7, 22, 22, 16, 17, 17, 17, 17, 4, 4, 4, 9, 9, 9, 14, 14, 14, 19, 19, 19)
  Set rng = .Cells(r + arow(0), aCol(0))
  For k = 1 To UBound(arow)
    Set rng = Union(rng, .Cells(r + arow(k), aCol(k)))
  Next k
  rng = Empty
  Set rng = Nothing
Nhấp chuột vào đây để mở rộng...
Cám ơn thầy nhiều ạ.
 
Upvote 0
Nhờ a/c viết giùm code để sheets tổng hợp làm được nhanh hơn
Bài đã được tự động gộp:

Nhờ a/c viết giúp code để tổng hợp nhiều sheets lại thành 1 sheets tổng hợp
 
Lần chỉnh sửa cuối:
Upvote 0
Tác giả bài trên chẳng biết muốn gì mà đăng hỏi câu ấy tùm lum hết.
 
Upvote 0
em là người mới, mong anh chị giúp đỡ nhiều.
em có 1 file muốn nhờ anh chị viết code VBA giúp em.
em cần tự động giãn dòng khi giá trị đấy xuất hiện lần đầu tiên ở cột AI.
trước đấy em cũng có thử viết code nhưng không ra được kết quả như mong muốn.
em cảm ơn anh chị nhiều
 

File đính kèm

Upvote 0
PHP: 
Sub ZanDong()
 Dim WF As Object, Rng As Range, Cls As Range
 Dim J As Long, Rws As Long, W
 Const MaX_ As Integer = 35:         Const Min_ As Integer = 23

 Set WF = Application.WorksheetFunction
 Rws = [AI10].End(xlDown).Row
 For J = 9 To Rws
    W = W + 1
    Set Rng = [AI9].Resize(W)
    If WF.CountIf(Rng, Cells(J, "AI").Value) = 1 Then
        Rows(J & ":" & J).RowHeight = MaX_
    Else
        Rows(J & ":" & J).RowHeight = Min_
    End If
 Next J
End Sub
 
Upvote 0
SA_DQ đã viết:
PHP: 
Sub ZanDong()
 Dim WF As Object, Rng As Range, Cls As Range
 Dim J As Long, Rws As Long, W
 Const MaX_ As Integer = 35:         Const Min_ As Integer = 23

 Set WF = Application.WorksheetFunction
 Rws = [AI10].End(xlDown).Row
 For J = 9 To Rws
    W = W + 1
    Set Rng = [AI9].Resize(W)
    If WF.CountIf(Rng, Cells(J, "AI").Value) = 1 Then
        Rows(J & ":" & J).RowHeight = MaX_
    Else
        Rows(J & ":" & J).RowHeight = Min_
    End If
 Next J
End Sub
Nhấp chuột vào đây để mở rộng...
Đọc ngược từ dưới lên trên, và dùng hàm Match để tìm. Nếu hàm Match cho vị trí ứng với dòng hiện tại thì đó là lần xuất hiện đầu tiên.
Dù sao thì Match cũng nhanh hơn CountIf một chút.
 
Upvote 0
SA_DQ đã viết:
PHP: 
Sub ZanDong()
 Dim WF As Object, Rng As Range, Cls As Range
 Dim J As Long, Rws As Long, W
 Const MaX_ As Integer = 35:         Const Min_ As Integer = 23

 Set WF = Application.WorksheetFunction
 Rws = [AI10].End(xlDown).Row
 For J = 9 To Rws
    W = W + 1
    Set Rng = [AI9].Resize(W)
    If WF.CountIf(Rng, Cells(J, "AI").Value) = 1 Then
        Rows(J & ":" & J).RowHeight = MaX_
    Else
        Rows(J & ":" & J).RowHeight = Min_
    End If
 Next J
End Sub
Nhấp chuột vào đây để mở rộng...
Application.WorksheetFunction thường giúp code ngắn gọn nhưng nếu dùng nhiều có thể làm chậm code.
Bài nầy dữ liệu được sắp xếp nên chỉ cần so sánh với ô trên nếu khác là thỏa điều kiện giãn dòng
 
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

OverAC
  • Dán lên cao
  • Suggestion Suggestion
Chúc mừng sinh nhật GiaiPhapExcel 19 tuổi và tặng ebook "Lập trình VBA phần cơ bản."
    • Thích
    • Yêu thích
Trả lời
5
Đọc
1K
longlacda
L
V
Công thức để phân công chuyên môn cho giáo viên
Trả lời
5
Đọc
258
vietvanyen
V
E
Đánh số cho các cặp số chứng từ và số chứng từ đối ứng
Trả lời
12
Đọc
227
Phan Thế Hiệp
Phan Thế Hiệp
G
AddIn convert ngày dương lịch sang âm lịch và ngược lại + đọc ngày tháng
Trả lời
20
Đọc
10K
du trung kien
D
8
Hàm trong excel
Trả lời
3
Đọc
60
Hoàng Tuấn 868
H
N
Chuyển giờ công từ bảng công vào bảng tính
Trả lời
16
Đọc
290
ngouyen1505
N
N
Tạo COM Add-In bằng Visual C++
    • Thích
Trả lời
7
Đọc
656
nguyendang95
N
T
Tìm số hóa đơn trong chuỗi
Trả lời
8
Đọc
353
tranhungdao12a3
T
Nga1852k
lỗi excel không chèn được dòng và không xóa được dòng
Trả lời
2
Đọc
134
Nga1852k
Nga1852k
D
  • Question Question
xin các cao thủ trợ giúp , hoặc nhận làm code có trả phí ạ
Trả lời
14
Đọc
1K
tung1423
tung1423
D
xin hỏi về lỗi mô đun ẩn.
Trả lời
3
Đọc
144
ongke0711
ongke0711
H
Xin anh chị hướng dẫn công thức excel ạ.
Trả lời
9
Đọc
287
Phan Thế Hiệp
Phan Thế Hiệp
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
381
Đọc
44K
tuanktt3
T
M
Add-in Excel kết nối cơ sở dữ liệu
Trả lời
1
Đọc
110
ptm0412
ptm0412
Đ
tách dữ liệu từ một dòng thành hai dòng
Trả lời
2
Đọc
152
Phuocam
Phuocam
longhuy
Lỗi error 20728: F
Trả lời
0
Đọc
76
longhuy
longhuy
H
Trang tính chỉ hiển thị vùng có dữ liệu
Trả lời
7
Đọc
606
vinhkm6
vinhkm6
mrjun80
Có hàm nào đếm tổng các số nằm trong 1 ô không mọi người
Trả lời
12
Đọc
498
Phan Thế Hiệp
Phan Thế Hiệp
N
Hàm DATEDIF trong Excel 2016
Trả lời
16
Đọc
14K
Phan Thế Hiệp
Phan Thế Hiệp
Tiger Nau
Đánh số thứ tự trên tờ vé số
Trả lời
6
Đọc
186
ptm0412
ptm0412
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