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

Liên hệ QC

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:
Dạ xin chào các bác,

Chả là em mới tập tành học VBA nên trình độ còn kém quá, có bài toán như ở file đính kèm nghĩ mãi mà vẫn chưa ra cách giải. Nhờ các bác chỉ giáo giúp em với ạ. Em cảm ơn nhiều.
Bạn chạy thử code này xem sao
Mã:
Dim Dem As Long
Sub Xuat()
Dim DL
Dim i, j, k
With Sheet1
    DL = .Range("a2", .Range("a1000000").End(xlUp))
    For i = 1 To UBound(DL)
        If DL(i, 1) <> "" Then
            j = j + 1
        End If
    Next i
    Dem = Dem + 1
    Dem = (Dem - 1) Mod j + 1
    
    For i = 1 To UBound(DL)
        If DL(i, 1) <> "" Then
            k = k + 1
            If k = Dem Then
                .Range("h1") = DL(i, 1)
                Exit For
            End If
        End If
    Next i
End With
End Sub
 
Upvote 0
Bạn chạy thử code này xem sao
Mã:
Dim Dem As Long
Sub Xuat()
Dim DL
Dim i, j, k
With Sheet1
    DL = .Range("a2", .Range("a1000000").End(xlUp))
    For i = 1 To UBound(DL)
        If DL(i, 1) <> "" Then
            j = j + 1
        End If
    Next i
    Dem = Dem + 1
    Dem = (Dem - 1) Mod j + 1
   
    For i = 1 To UBound(DL)
        If DL(i, 1) <> "" Then
            k = k + 1
            If k = Dem Then
                .Range("h1") = DL(i, 1)
                Exit For
            End If
        End If
    Next i
End With
End Sub
Chuẩn luôn rồi bác ạ. Mỗi tội em đọc code của bác không hiểu gì cả :( chắc tại em thiếu kiến thức quá, để em mày mò học thêm vậy :(
Tks bác nhiều nhé.
 
Upvote 0
Chào các anh chị,

Em cũng mới tập viết VBA, đoạn code sau em check đi check lại không bị lỗi gì nhưng không hiểu sao lại không chạy. Nhờ các anh chị kiểm tra giúp em với ạ. Mục tiêu của đoạn code là khi gõ mã vào cột 1 của Sheet 1 thì Excel sẽ tìm kiếm dòng công thức từ thư viện "Lib" để copy vào dòng vừa gõ mã. Em cảm ơn các anh chị.

Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim var As Variant
    Dim Add As String
    If Target.Cells.Count > 1 Then
        Exit Sub
    End If
    On Error GoTo ErrHandler:
    
    If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
        Add = Intersect(Target, Range("A:A")).Address
        var = Application.Match(Range(Add).Value, Worksheets("Lib").Columns(1), 0)
        Worksheets("Lib").Rows(var).Copy
        Worksheets("Sheet1").Range(Add).Paste
        
    End If
ErrHandler:
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Chào mọi người, mọi người giúp em về code VBA cho việc tính các thông số rij (thời gian sẵn sàng), dij (thời gian tới hạn) của các công việc trên sơ đồ mạng ạ.
Cụ thể như hình đính kèm214307
Ví dụ có 3 công việc được gia công trên 4 máy như hình (ô 2,1 thì 2 là máy 2, 1 là công việc 1 ạ). Em sử dụng giải thuật shifting bottleneck để điều độ các công việc. Đầu tiên, em tính rij, dij cho tungwg ô như vậy, sau đó sẽ tìm được máy nghẽn rồi chọn thứ tự điều độ trên đó (trên hình là máy 1). Sau đó em sẽ tiến hành tính lại rij, dij của sơ đồ mạng mới (có thêm các đường nối giữa các công việc trên máy 1). Sau đó lại tìm máy nghẽn, rồi lặp lại cho tới khi hết máy nghẽn.
Em tính được rij, dij của lần đầu tiên, nhưng sau khi lặp, có thêm có đường liên kết mới, em không biết viết code để tính thế nào. Mọi người giúp em với ạ. Em cảm ơn
 
Upvote 0
Các anh chị trong diễn đàn có ai biết tài liệu về VBA để vẽ biểu đồ và tinh chỉnh biểu đồ không? Cho em xin với. Xin cám ơn !
 
Upvote 0
các thầy cho em hỏi 1 xíu ạ. ví dụ em nghĩ như này:
nếu tên sheet = "a" hoặc "b" thì....
sẽ phải viết code như nào ạ
 
Upvote 0
Chẳng hạn workbook của em nó có nhiều sheets chẳng hạn. Thì có Phải khai bao biến hay như thế nào không ạ
Vậy dùng thế này.
Mã:
Sub GPE()
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
    If sh.Name = "a" Or sh.Name = "b" Then MsgBox "lam dai cong viec gi do"
Next sh
End Sub
 
Upvote 0
Vậy dùng thế này.
Mã:
Sub GPE()
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
    If sh.Name = "a" Or sh.Name = "b" Then MsgBox "lam dai cong viec gi do"
Next sh
End Sub
Nếu như mà em muốn làm gì đó trên cả 2 sheet a và b. Chẳng hạn a1 của cả 2 sheet cùng 1 kiểu thì viết đường dẫn vào từng sheet 1 ạ
 
Upvote 0
Mã:
Sub Boimau()
  Dim ws As Worksheet, LastRow As Long
  For Each ws In Worksheets
    If ws.Name = "Makikaeshi" Or ws.Name = "Yokomaki" Or ws.Name = "Tsunagi" Then
      With ws.Activate
        LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
      ws.Range("N7:O" & LastRown).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
      End With

    End If
  Next ws
End Sub
Nhờ các thầy xem giúp em. đoạn code tren em đang sai ở chỗ nào với ạ, mà không thấy nó chạy
 
Upvote 0
Mã:
Sub Boimau()
  Dim ws As Worksheet, LastRow As Long
  For Each ws In Worksheets
    If ws.Name = "Makikaeshi" Or ws.Name = "Yokomaki" Or ws.Name = "Tsunagi" Then
      With ws.Activate
        LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
      ws.Range("N7:O" & LastRown).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
      End With

    End If
  Next ws
End Sub
Nhờ các thầy xem giúp em. đoạn code tren em đang sai ở chỗ nào với ạ, mà không thấy nó chạy
Bạn xem thử code dưới đây
Các dòng có dấu ' là lệnh cũ, dưới liền kề là mới
Mã:
Sub Boimau()
  Dim ws As Worksheet, LastRow As Long
  For Each ws In Worksheets
    If ws.Name = "Makikaeshi" Or ws.Name = "Yokomaki" Or ws.Name = "Tsunagi" Then
      'With ws.Activate
      ws.Activate
        'LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
        LastRow = Range("H" & Rows.Count).End(xlUp).Row
      'ws.Range("N7:O" & LastRown).Interior
      With ws.Range("N7:O" & LastRow).Interior '<-- LastRown sua thanh LastRow
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
      End With

    End If
  Next ws
End Sub
 
Upvote 0
Nhờ các anh chị giúp CODE ạ. Tôi muốn viết 1 macro lấy tên đối tượng mình click vào mà chưa làm được. Xin cám ơn trước ạ!
 

File đính kèm

  • SS1.xlsm
    17.7 KB · Đọc: 5
Upvote 0
chào các thầy cô. cho em hỏi 1 chút à. có code nào khi mà em mở 1 file excell A lên. thì đồng thời file excell B ở thư mục khác sẽ cũng được mở lên cùng không ạ.
 
Upvote 0
chào các thầy cô. cho em hỏi 1 chút à. có code nào khi mà em mở 1 file excell A lên. thì đồng thời file excell B ở thư mục khác sẽ cũng được mở lên cùng không ạ.
Có bạn viết code mở file B rồi vứt nó vào sự kiện mở file trong excel A là được nhé.
 
Upvote 0
Nhờ các Bạn chỉ giúp mình gộp code bên dưới:
Mã:
If sArr(I, 23) <> Empty Then
        If Month(sArr(I, 23)) < 10 Then
            dArr(I, 3) = Right(sArr(I, 23), 2)
        ElseIf Month(sArr(I, 23)) > 9 Then
            dArr(I, 3) = Right(sArr(I, 23), 2) + 1
    End If
End If

    If sArr(I, 23) = Empty Then
            dArr(I, 3) = "kg"
        End If
Xin cảm ơn.
 
Upvote 0
Nhờ các Bạn chỉ giúp mình gộp code bên dưới:
Mã:
Xin cảm ơn.
[/QUOTE]
Bạn gộp vậy xem sao.
[CODE]If sArr(I, 23) <> Empty Then
        If Month(sArr(I, 23)) < 10 Then
            dArr(I, 3) = Right(sArr(I, 23), 2)
        ElseIf Month(sArr(I, 23)) > 9 Then
            dArr(I, 3) = Right(sArr(I, 23), 2) + 1
    End If
Else
   dArr(I, 3) = "kg"
End If
 
Upvote 0
Dear A/c có cách nào giúp tốc độ code phia dưới nhanh hơn dc ko , nhờ a/c giúp
Code dưới là ghi dữ liệu từ textbox trên userform vào sheet

Mã:
Private Sub CommandButton5_Click()

Dim lastrow As Long
Dim i As Long
With Sheets("Pak_in")
For i = 1 To 115 Step 6
lastrow = Sheets("Pak_in").Cells(Rows.Count, "D").End(xlUp).Row + 1
If Controls("TextBox" & i) = "" Then Exit Sub
.Range("D" & lastrow) = Controls("TextBox" & i)
.Range("E" & lastrow) = Controls("TextBox" & i + 1)
.Range("F" & lastrow) = Controls("TextBox" & i + 2)
.Range("G" & lastrow) = Controls("TextBox" & i + 3)
.Range("H" & lastrow) = Controls("TextBox" & i + 4).Value
.Range("I" & lastrow) = Controls("TextBox" & i + 5)

 Controls("TextBox" & i) = ""
 Controls("TextBox" & i + 1) = ""
 Controls("TextBox" & i + 2) = ""
 Controls("TextBox" & i + 3) = ""
 Controls("TextBox" & i + 4) = ""
 Controls("TextBox" & i + 5) = ""
Next i
End With
End Sub
 
Upvote 0
Web KT
Back
Top Bottom