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:
Trên bàn phím có phím Delete đó bạn, bấm vô.
 
Upvote 0
Mọi người ơi xem dùm code này bị lỗi gì và nên xử lý thế nào. Đơn thuần là mình muốn cột 21 = cột 15 - cột 4
Mã:
Sub Update_Data()
Dim sArr(), i As Long, j As Long, Dic As Object, ResignedList()
Set Dic = CreateObject("scripting.dictionary")
With Sheets("Resigned List")
   ResignedList = .Range("A6", .Range("A" & Rows.Count).End(3)).Resize(, 10).Value
End With
For i = 1 To UBound(ResignedList)
   If Not Dic.exists(ResignedList(i, 2)) Then
      Dic.Add ResignedList(i, 2), ResignedList(i, 7)
   Else
      MsgBox "Duplicate " & ResignedList(i, 2)
   End If
Next
With Sheets("Candidates")
   sArr = .Range("A7", .Range("A" & Rows.Count).End(3)).Resize(, 21).Value
   For i = 1 To UBound(sArr)
      For j = 1 To UBound(sArr, 2)
         sArr(i, j) = Application.Trim(sArr(i, j))
      Next
      If IsDate(sArr(i, 4)) Then
         sArr(i, 18) = MonthName(Month(sArr(i, 4)), True)
         sArr(i, 19) = Year(sArr(i, 4))
      End If
      If Dic.exists(sArr(i, 5)) Then
         sArr(i, 15) = Dic.Item(sArr(i, 5))
         sArr(i, 14) = "Resigned"
         If IsDate(sArr(i, 4)) Then
            sArr(i, 21) = sArr(i, 15) - sArr(i, 4)
            If sArr(i, 21) < 4 Then
               sArr(i, 20) = "A"
            ElseIf sArr(i, 21) < 8 Then
               sArr(i, 20) = "B"
            ElseIf sArr(i, 21) < 31 Then
               sArr(i, 20) = "C"
            ElseIf sArr(i, 21) > 30 Then
               sArr(i, 20) = "D"
            End If
         End If
      End If
   Next
   .[A7].Resize(UBound(sArr), UBound(sArr, 2)) = sArr
End With
End Sub
 

File đính kèm

  • Recruitment status report.xlsb
    217.3 KB · Đọc: 10
Upvote 0
Mọi người ơi xem dùm code này bị lỗi gì và nên xử lý thế nào. Đơn thuần là mình muốn cột 21 = cột 15 - cột 4
Mã:
Sub Update_Data()
Dim sArr(), i As Long, j As Long, Dic As Object, ResignedList()
Set Dic = CreateObject("scripting.dictionary")
With Sheets("Resigned List")
   ResignedList = .Range("A6", .Range("A" & Rows.Count).End(3)).Resize(, 10).Value
End With
For i = 1 To UBound(ResignedList)
   If Not Dic.exists(ResignedList(i, 2)) Then
      Dic.Add ResignedList(i, 2), ResignedList(i, 7)
   Else
      MsgBox "Duplicate " & ResignedList(i, 2)
   End If
Next
With Sheets("Candidates")
   sArr = .Range("A7", .Range("A" & Rows.Count).End(3)).Resize(, 21).Value
   For i = 1 To UBound(sArr)
      For j = 1 To UBound(sArr, 2)
         sArr(i, j) = Application.Trim(sArr(i, j))
      Next
      If IsDate(sArr(i, 4)) Then
         sArr(i, 18) = MonthName(Month(sArr(i, 4)), True)
         sArr(i, 19) = Year(sArr(i, 4))
      End If
      If Dic.exists(sArr(i, 5)) Then
         sArr(i, 15) = Dic.Item(sArr(i, 5))
         sArr(i, 14) = "Resigned"
         If IsDate(sArr(i, 4)) Then
            sArr(i, 21) = sArr(i, 15) - sArr(i, 4)
            If sArr(i, 21) < 4 Then
               sArr(i, 20) = "A"
            ElseIf sArr(i, 21) < 8 Then
               sArr(i, 20) = "B"
            ElseIf sArr(i, 21) < 31 Then
               sArr(i, 20) = "C"
            ElseIf sArr(i, 21) > 30 Then
               sArr(i, 20) = "D"
            End If
         End If
      End If
   Next
   .[A7].Resize(UBound(sArr), UBound(sArr, 2)) = sArr
End With
End Sub
Ai lại cắt vô tội vạ như thế :D
Rich (BB code):
      For j = 1 To UBound(sArr, 2)
        If TypeName(sArr(i, j)) = "String" Then sArr(i, j) = Application.Trim(sArr(i, j))
      Next
 
Upvote 0
Mọi người ơi xem dùm code này bị lỗi gì và nên xử lý thế nào. Đơn thuần là mình muốn cột 21 = cột 15 - cột 4
Mã:
Sub Update_Data()
Dim sArr(), i As Long, j As Long, Dic As Object, ResignedList()
Set Dic = CreateObject("scripting.dictionary")
With Sheets("Resigned List")
   ResignedList = .Range("A6", .Range("A" & Rows.Count).End(3)).Resize(, 10).Value
End With
For i = 1 To UBound(ResignedList)
   If Not Dic.exists(ResignedList(i, 2)) Then
      Dic.Add ResignedList(i, 2), ResignedList(i, 7)
   Else
      MsgBox "Duplicate " & ResignedList(i, 2)
   End If
Next
With Sheets("Candidates")
   sArr = .Range("A7", .Range("A" & Rows.Count).End(3)).Resize(, 21).Value
   For i = 1 To UBound(sArr)
      For j = 1 To UBound(sArr, 2)
         sArr(i, j) = Application.Trim(sArr(i, j))
      Next
      If IsDate(sArr(i, 4)) Then
         sArr(i, 18) = MonthName(Month(sArr(i, 4)), True)
         sArr(i, 19) = Year(sArr(i, 4))
      End If
      If Dic.exists(sArr(i, 5)) Then
         sArr(i, 15) = Dic.Item(sArr(i, 5))
         sArr(i, 14) = "Resigned"
         If IsDate(sArr(i, 4)) Then
            sArr(i, 21) = sArr(i, 15) - sArr(i, 4)
            If sArr(i, 21) < 4 Then
               sArr(i, 20) = "A"
            ElseIf sArr(i, 21) < 8 Then
               sArr(i, 20) = "B"
            ElseIf sArr(i, 21) < 31 Then
               sArr(i, 20) = "C"
            ElseIf sArr(i, 21) > 30 Then
               sArr(i, 20) = "D"
            End If
         End If
      End If
   Next
   .[A7].Resize(UBound(sArr), UBound(sArr, 2)) = sArr
End With
End Sub
Em chỉnh lại thành sArr(i, 21) = CDate(sArr(i, 15)) - CDate(sArr(i, 4)) thì thấy hết lỗi, không biết đúng không nữa anh ơi
 
Upvote 0
Em chỉnh lại thành sArr(i, 21) = CDate(sArr(i, 15)) - CDate(sArr(i, 4)) thì thấy hết lỗi, không biết đúng không nữa anh ơi
Mình cũng test đủ kiểu, CDate, rồi cả DateValue cũng không ăn thua. Nó hết lỗi nhưng kết quả ra không đúng. Tại dòng đầu nó cứ cho kết quả là Aug
 
Upvote 0
Ai lại cắt vô tội vạ như thế :D
Rich (BB code):
      For j = 1 To UBound(sArr, 2)
        If TypeName(sArr(i, j)) = "String" Then sArr(i, j) = Application.Trim(sArr(i, j))
      Next
À giờ mình hiểu rồi. Sau khi trim thì dữ liệu ngày giờ sẽ bị chuyển sang Text.

Cảm ơn sự giải đáp của HuuThang, đã cho mình một kiến thức mới
 
Upvote 0
Mình cũng test đủ kiểu, CDate, rồi cả DateValue cũng không ăn thua. Nó hết lỗi nhưng kết quả ra không đúng. Tại dòng đầu nó cứ cho kết quả là Aug
Em đoán là cái hàm Cdate nó quy đổi về ngày tháng năm không đúng.Anh dùng hàm này theo thủ công chắc là được. DateSerial .
 
Upvote 0
Upvote 0
Nhờ các bạn hỗ trợ : Mình đang cần một file khi user nhập liệu thì cho phép, sau khi nhập thì không thể xóa. Mình không biết tìm google với từ khóa nào. Mong các bạn hỗ trợ. Cám ơn các bạn rất nhiều.
 
Upvote 0
Nhờ các bạn hỗ trợ : Mình đang cần một file khi user nhập liệu thì cho phép, sau khi nhập thì không thể xóa. Mình không biết tìm google với từ khóa nào. Mong các bạn hỗ trợ. Cám ơn các bạn rất nhiều.
Làm chơi cho vui, chỉ áp dụng được với dân tay mơ. Nếu bạn biết cách xóa dữ liệu đã nhập hoặc nhập dữ liệu mà không bị khóa thì khỏi áp dụng (vì người khác cũng sẽ làm được :D)
 

File đính kèm

  • ABC.xlsm
    15 KB · Đọc: 6
Upvote 0
...khỏi áp dụng (vì người khác cũng sẽ làm được :D)
Đương nhiên những gì khoá ở đây thì người dùng chỉ việc đưa lên đây nhờ bẻ khoá.

Nhưng điểm tôi sợ nhất không phải ở chỗ bẻ khoá. Tôi sợ nhất những thằng táo tỉnh, chúng mở khoá, sửa đổi, rồi khoá lại hoàn toàn như chẳng có gì xảy ra.
"Cái đó sếp khoá rồi mà. Em đâu có làm gì được!"
 
Upvote 0
Nhờ các bác check hộ code em sai chỗ nào, kết quả chạy không được như mong muốn.

File của em như sau:
1. Sheet2 : Sheet copy các dữ liệu đường kính và độ cứng tổng hợp về
2. Sheet 1 (các bác không cần soi)
3. Các sheet phía sau : Sheet thứ 3 đến sheet thứ 15 (dữ liệu đường kính), Sheet thứ 16 đến sheet thứ 28 (dữ liệu độ cứng)

Code em chỉ trình độ ABC thôi để đạt mục đích công việc thôi:p
 

File đính kèm

  • Copy data từ nhiều sheet về 1 sheet (FILE CHẠY MACRO).xlsm
    1.2 MB · Đọc: 4
  • Copy data từ nhiều sheet về 1 sheet (FILE GỐC).xlsm
    992.2 KB · Đọc: 3
Upvote 0
Bạn thử với cái ni:
PHP:
Sub Copy_data_Diameter()

Dim sRng As Range
Dim i As Integer, lastRow As Integer
lastRow = 16

For i = 1 To 13
    With Sheets(i + 2)
        MsgBox .Range("A23:Q" & .Range("A" & Rows.Count).End(xlUp).Row).Address '**
        .Range("A23:Q" & .Range("A" & Rows.Count).End(xlUp).Row).Copy
        Sheet2.Range("B" & lastRow).PasteSpecial Paste:=xlPasteValues
        .Range("E5").Copy
        Sheet2.Range("A" & lastRow).PasteSpecial Paste:=xlPasteValues
        lastRow = Sheet2.Range("B65000").End(xlUp).Row + 1    
    End With
Next i   
End Sub
 
Upvote 0
Bạn thử với cái ni:
PHP:
Sub Copy_data_Diameter()

Dim sRng As Range
Dim i As Integer, lastRow As Integer
lastRow = 16

For i = 1 To 13
    With Sheets(i + 2)
        MsgBox .Range("A23:Q" & .Range("A" & Rows.Count).End(xlUp).Row).Address '**
        .Range("A23:Q" & .Range("A" & Rows.Count).End(xlUp).Row).Copy
        Sheet2.Range("B" & lastRow).PasteSpecial Paste:=xlPasteValues
        .Range("E5").Copy
        Sheet2.Range("A" & lastRow).PasteSpecial Paste:=xlPasteValues
        lastRow = Sheet2.Range("B65000").End(xlUp).Row + 1   
    End With
Next i  
End Sub

Chào bác @SA_DQ !!!

Em thử chạy code của bác và đạt được kết quả như mong muốn.
Bác giúp em giải thích code em điểm nào sai với ah.

Tại sao marco Copy_data_hardness em chỉ copy từ Copy_data_diameter chỉnh sửa theo thì không bị sai ah.
Xin bác chỉ giáo giúp em để những lần tới em sửa sai.

Thanks bác nhiều nhiều.
Bài đã được tự động gộp:

Chào bác @SA_DQ !!!

Em thử chạy code của bác và đạt được kết quả như mong muốn.
Bác giúp em giải thích code em điểm nào sai với ah.

Tại sao marco Copy_data_hardness em chỉ copy từ Copy_data_diameter chỉnh sửa theo thì không bị sai ah.
Xin bác chỉ giáo giúp em để những lần tới em sửa sai.

Thanks bác nhiều nhiều.

Chào bác @SA_DQ !!!

Em soi ra rồi. Có phải em sai: thiếu dấu chấm ở chỗ tô đỏ dưới phải không ạh?
.Range("A23:Q" & .Range("A" & Rows.Count).End(xlUp).Row).Copy

Em cám bác nhiều
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn xem 2 dòng lệnh này:
PHP:
MsgBox .Range("A23:Q" & .Range("A" & Rows.Count).End(xlUp).Row).Address
       .Range("A23:Q" & Range("A" & Rows.Count).End(xlUp).Row).Copy
Khi xài With . . .. End With
 
Upvote 0
Các bác cho em hỏi em muốn từ excel mở một file word lên - tìm và xóa dòng chữ trong file word vừa mở thì làm thế nào ạ.
 
Upvote 0
Web KT
Back
Top Bottom