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

Liên hệ QC
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
vanmanhvcu đã viết:
Xin chào mọi người
tôi có làm 1 sub để tạo mô hình mẫu
dùng application.inputbox để lựa chọn ô sẽ lưu mô hình mẫu

1. Nhưng chỉ ra kết quả mong muốn trong ActiveSheet là đúng (hình 1)- Sheet2 là sheet hiện hoạt
2. Còn những sheets (sheet KetQua không được kích hoạt) khác thì định đạng không đúng, vì sao vậy? (hình 2)
3. Khác phục như thế nào?
View attachment 220159
View attachment 220160
Nhấp chuột vào đây để mở rộng...
Bạn bị sai ở tất cả các lệnh cells(..., ...), do lệnh cells nó hiểu là sheet hiện tại. Để khắc phục bạn thử sửa lại code thế này.
Mã: 
Sub MoHinhMau()
Dim DesTemp As Range, Des As Range

On Error Resume Next
    Set DesTemp = Application.InputBox("Ch" & ChrW(7885) & "n ô t" & ChrW(7841) & _
        "o mô hình m" & ChrW(7851) & "u", "Mô hình m" & ChrW(7851) & _
        "u", Default:=ActiveWindow.ActiveCell.Address, Type:=8)

If Err.Number <> 0 Then Exit Sub

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

If IsArray(DesTemp) = True Then
   Set Des = DesTemp.Cells(1, 1)
Else
    Set Des = DesTemp
End If

With Des.Resize(11, 7)
    .Clear
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
End With
    With Des.Resize(9, 5)

        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
    
    With Des.Offset(10, 1).Resize(, 4)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Interior.Color = 65535
    End With
    With Des.Offset(2, 6).Resize(7)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Interior.Color = 65535
    End With
    
    With Des.Offset(3, 2).Resize(6, 3)
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlInsideVertical).Weight = xlMedium
        .Borders(xlInsideHorizontal).Weight = xlMedium
        .Interior.Color = 65280
    End With
    
    With Des.Resize(2, 1)
        .MergeCells = True
        .FormulaR1C1 = "Day"
        .Font.Bold = True
    End With
    With Des.Resize(11, 7)
        .Cells(1, 2).FormulaR1C1 = "L" & ChrW(432) & ChrW(7907) & "ng (Kg)"
        .Cells(1, 2).Font.Bold = True
        .Cells(1, 3).FormulaR1C1 = "10000"
        .Cells(1, 4).FormulaR1C1 = "4900"
        .Cells(1, 5).FormulaR1C1 = "4900"
        .Cells(2, 2).FormulaR1C1 = "Kho"
        .Cells(2, 2).Font.Bold = True
        .Cells(2, 3).FormulaR1C1 = "1250"
        .Cells(2, 4).FormulaR1C1 = "652"
        .Cells(2, 5).FormulaR1C1 = "590"
        .Cells(3, 1).FormulaR1C1 = "Yêu C" & ChrW(7847) & "u" & Chr(10) & "(Kg)"
        .Cells(3, 1).Font.Bold = True
        .Cells(3, 2).FormulaR1C1 = "So luong" & Chr(10) & "-----------" & "Tip"
    
        .Cells(3, 2).Font.Bold = True
        .Cells(3, 3).FormulaR1C1 = "2"
        .Cells(3, 4).FormulaR1C1 = "6"
        .Cells(3, 5).FormulaR1C1 = "8"
        .Cells(3, 7).FormulaR1C1 = "K" & ChrW(7871) & "t qu" & ChrW(7843)
        .Cells(3, 7).Font.Bold = True
        .Cells(4, 1).FormulaR1C1 = "4000"
        .Cells(4, 2).FormulaR1C1 = "91"
        .Cells(4, 3).FormulaR1C1 = "0"
        .Cells(4, 4).FormulaR1C1 = "1"
        .Cells(4, 5).FormulaR1C1 = "0"
        .Cells(4, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-3]C[-4]:R[-3]C[-2]*R[-1]C[-4]:R[-1]C[-2]*RC[-4]:RC[-2]/R[-2]C[-4]:R[-2]C[-2])"
        .Cells(5, 1).FormulaR1C1 = "2000"
        .Cells(5, 2).FormulaR1C1 = "127"
        .Cells(5, 3).FormulaR1C1 = "1"
        .Cells(5, 4).FormulaR1C1 = "0"
        .Cells(5, 5).FormulaR1C1 = "0"
        .Cells(5, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-4]C[-4]:R[-4]C[-2]*R[-2]C[-4]:R[-2]C[-2]*RC[-4]:RC[-2]/R[-3]C[-4]:R[-3]C[-2])"
        .Cells(6, 1).FormulaR1C1 = "25000"
        .Cells(6, 2).FormulaR1C1 = "153"
        .Cells(6, 3).FormulaR1C1 = "2"
        .Cells(6, 4).FormulaR1C1 = "0"
        .Cells(6, 5).FormulaR1C1 = "2"
        .Cells(6, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-5]C[-4]:R[-5]C[-2]*R[-3]C[-4]:R[-3]C[-2]*RC[-4]:RC[-2]/R[-4]C[-4]:R[-4]C[-2])"
        .Cells(7, 1).FormulaR1C1 = "5200"
        .Cells(7, 2).FormulaR1C1 = "173"
        .Cells(7, 3).FormulaR1C1 = "2"
        .Cells(7, 4).FormulaR1C1 = "0"
        .Cells(7, 5).FormulaR1C1 = "0"
        .Cells(7, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-6]C[-4]:R[-6]C[-2]*R[-4]C[-4]:R[-4]C[-2]*RC[-4]:RC[-2]/R[-5]C[-4]:R[-5]C[-2])"
        .Cells(8, 1).FormulaR1C1 = "7200"
        .Cells(8, 2).FormulaR1C1 = "233"
        .Cells(8, 3).FormulaR1C1 = "2"
        .Cells(8, 4).FormulaR1C1 = "0"
        .Cells(8, 5).FormulaR1C1 = "0"
        .Cells(8, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-7]C[-4]:R[-7]C[-2]*R[-5]C[-4]:R[-5]C[-2]*RC[-4]:RC[-2]/R[-6]C[-4]:R[-6]C[-2])"
        .Cells(9, 1).FormulaR1C1 = "42000"
        .Cells(9, 2).FormulaR1C1 = "277"
        .Cells(9, 3).FormulaR1C1 = "0"
        .Cells(9, 4).FormulaR1C1 = "2"
        .Cells(9, 5).FormulaR1C1 = "1"
        .Cells(9, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-8]C[-4]:R[-8]C[-2]*R[-6]C[-4]:R[-6]C[-2]*RC[-4]:RC[-2]/R[-7]C[-4]:R[-7]C[-2])"
        .Cells(11, 2).FormulaR1C1 = "Thua"
        .Cells(11, 2).Font.Bold = True
        .Cells(11, 3).FormulaR1C1 = "=R[-9]C-SUMPRODUCT(R[-7]C[-1]:R[-2]C[-1]*R[-7]C:R[-2]C)"
        .Cells(11, 4).FormulaR1C1 = "=R[-9]C-SUMPRODUCT(R[-7]C[-2]:R[-2]C[-2]*R[-7]C:R[-2]C)"
        .Cells(11, 5).FormulaR1C1 = "=R[-9]C-SUMPRODUCT(R[-7]C[-3]:R[-2]C[-3]*R[-7]C:R[-2]C)"
        .Columns.AutoFit
        .Rows.AutoFit
        .Columns(6).EntireColumn.ColumnWidth = 3
    End With
    Des.Offset(, 2).Resize(, 3).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
    Des.Offset(2).Resize(6).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
    Des.Offset(2, 6).Resize(6).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = False

End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
giaiphap đã viết:
Bạn bị sai ở tất cả các lệnh cells(..., ...), do lệnh cells nó hiểu là sheet hiện tại. Để khắc phục bạn thử sửa lại code thế này.
Mã: 
Sub MoHinhMau()
...............................................
    With Des.Resize(9, 5)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
...............................................
End Sub
Nhấp chuột vào đây để mở rộng...
Anh có tổng kết các cách tô viềng ở bài này VBA, tô viềng trong Excel
 
Upvote 0
Vài ngày trước mình có tải một file VBA chèn ảnh vào exel như thế này. Khi ở trạng thái wooksheet file vẫn hiện hình ảnh bình thường, tuy nhiên khi chuyển sang chế độ in thì file không hiển thị hình ảnh để in. Anh/Chị nào giúp em sửa lại code để in được hình với. Dja Em cảm ơn nhiều ạ!
 

File đính kèm

  • ComPic.xls
    55 KB · Đọc: 4
Upvote 0
giaiphap đã viết:
Bạn bị sai ở tất cả các lệnh cells(..., ...), do lệnh cells nó hiểu là sheet hiện tại. Để khắc phục bạn thử sửa lại code thế này.
Mã: 
Sub MoHinhMau()
Dim DesTemp As Range, Des As Range

On Error Resume Next
    Set DesTemp = Application.InputBox("Ch" & ChrW(7885) & "n ô t" & ChrW(7841) & _
        "o mô hình m" & ChrW(7851) & "u", "Mô hình m" & ChrW(7851) & _
        "u", Default:=ActiveWindow.ActiveCell.Address, Type:=8)

If Err.Number <> 0 Then Exit Sub

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

If IsArray(DesTemp) = True Then
   Set Des = DesTemp.Cells(1, 1)
Else
    Set Des = DesTemp
End If

With Des.Resize(11, 7)
    .Clear
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
End With
    With Des.Resize(9, 5)

        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
  
    With Des.Offset(10, 1).Resize(, 4)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Interior.Color = 65535
    End With
    With Des.Offset(2, 6).Resize(7)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Interior.Color = 65535
    End With
  
    With Des.Offset(3, 2).Resize(6, 3)
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlInsideVertical).Weight = xlMedium
        .Borders(xlInsideHorizontal).Weight = xlMedium
        .Interior.Color = 65280
    End With
  
    With Des.Resize(2, 1)
        .MergeCells = True
        .FormulaR1C1 = "Day"
        .Font.Bold = True
    End With
    With Des.Resize(11, 7)
        .Cells(1, 2).FormulaR1C1 = "L" & ChrW(432) & ChrW(7907) & "ng (Kg)"
        .Cells(1, 2).Font.Bold = True
        .Cells(1, 3).FormulaR1C1 = "10000"
        .Cells(1, 4).FormulaR1C1 = "4900"
        .Cells(1, 5).FormulaR1C1 = "4900"
        .Cells(2, 2).FormulaR1C1 = "Kho"
        .Cells(2, 2).Font.Bold = True
        .Cells(2, 3).FormulaR1C1 = "1250"
        .Cells(2, 4).FormulaR1C1 = "652"
        .Cells(2, 5).FormulaR1C1 = "590"
        .Cells(3, 1).FormulaR1C1 = "Yêu C" & ChrW(7847) & "u" & Chr(10) & "(Kg)"
        .Cells(3, 1).Font.Bold = True
        .Cells(3, 2).FormulaR1C1 = "So luong" & Chr(10) & "-----------" & "Tip"
  
        .Cells(3, 2).Font.Bold = True
        .Cells(3, 3).FormulaR1C1 = "2"
        .Cells(3, 4).FormulaR1C1 = "6"
        .Cells(3, 5).FormulaR1C1 = "8"
        .Cells(3, 7).FormulaR1C1 = "K" & ChrW(7871) & "t qu" & ChrW(7843)
        .Cells(3, 7).Font.Bold = True
        .Cells(4, 1).FormulaR1C1 = "4000"
        .Cells(4, 2).FormulaR1C1 = "91"
        .Cells(4, 3).FormulaR1C1 = "0"
        .Cells(4, 4).FormulaR1C1 = "1"
        .Cells(4, 5).FormulaR1C1 = "0"
        .Cells(4, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-3]C[-4]:R[-3]C[-2]*R[-1]C[-4]:R[-1]C[-2]*RC[-4]:RC[-2]/R[-2]C[-4]:R[-2]C[-2])"
        .Cells(5, 1).FormulaR1C1 = "2000"
        .Cells(5, 2).FormulaR1C1 = "127"
        .Cells(5, 3).FormulaR1C1 = "1"
        .Cells(5, 4).FormulaR1C1 = "0"
        .Cells(5, 5).FormulaR1C1 = "0"
        .Cells(5, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-4]C[-4]:R[-4]C[-2]*R[-2]C[-4]:R[-2]C[-2]*RC[-4]:RC[-2]/R[-3]C[-4]:R[-3]C[-2])"
        .Cells(6, 1).FormulaR1C1 = "25000"
        .Cells(6, 2).FormulaR1C1 = "153"
        .Cells(6, 3).FormulaR1C1 = "2"
        .Cells(6, 4).FormulaR1C1 = "0"
        .Cells(6, 5).FormulaR1C1 = "2"
        .Cells(6, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-5]C[-4]:R[-5]C[-2]*R[-3]C[-4]:R[-3]C[-2]*RC[-4]:RC[-2]/R[-4]C[-4]:R[-4]C[-2])"
        .Cells(7, 1).FormulaR1C1 = "5200"
        .Cells(7, 2).FormulaR1C1 = "173"
        .Cells(7, 3).FormulaR1C1 = "2"
        .Cells(7, 4).FormulaR1C1 = "0"
        .Cells(7, 5).FormulaR1C1 = "0"
        .Cells(7, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-6]C[-4]:R[-6]C[-2]*R[-4]C[-4]:R[-4]C[-2]*RC[-4]:RC[-2]/R[-5]C[-4]:R[-5]C[-2])"
        .Cells(8, 1).FormulaR1C1 = "7200"
        .Cells(8, 2).FormulaR1C1 = "233"
        .Cells(8, 3).FormulaR1C1 = "2"
        .Cells(8, 4).FormulaR1C1 = "0"
        .Cells(8, 5).FormulaR1C1 = "0"
        .Cells(8, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-7]C[-4]:R[-7]C[-2]*R[-5]C[-4]:R[-5]C[-2]*RC[-4]:RC[-2]/R[-6]C[-4]:R[-6]C[-2])"
        .Cells(9, 1).FormulaR1C1 = "42000"
        .Cells(9, 2).FormulaR1C1 = "277"
        .Cells(9, 3).FormulaR1C1 = "0"
        .Cells(9, 4).FormulaR1C1 = "2"
        .Cells(9, 5).FormulaR1C1 = "1"
        .Cells(9, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-8]C[-4]:R[-8]C[-2]*R[-6]C[-4]:R[-6]C[-2]*RC[-4]:RC[-2]/R[-7]C[-4]:R[-7]C[-2])"
        .Cells(11, 2).FormulaR1C1 = "Thua"
        .Cells(11, 2).Font.Bold = True
        .Cells(11, 3).FormulaR1C1 = "=R[-9]C-SUMPRODUCT(R[-7]C[-1]:R[-2]C[-1]*R[-7]C:R[-2]C)"
        .Cells(11, 4).FormulaR1C1 = "=R[-9]C-SUMPRODUCT(R[-7]C[-2]:R[-2]C[-2]*R[-7]C:R[-2]C)"
        .Cells(11, 5).FormulaR1C1 = "=R[-9]C-SUMPRODUCT(R[-7]C[-3]:R[-2]C[-3]*R[-7]C:R[-2]C)"
        .Columns.AutoFit
        .Rows.AutoFit
        .Columns(6).EntireColumn.ColumnWidth = 3
    End With
    Des.Offset(, 2).Resize(, 3).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
    Des.Offset(2).Resize(6).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
    Des.Offset(2, 6).Resize(6).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = False

End Sub
Nhấp chuột vào đây để mở rộng...
Cám ơn Bạn đã giúp đỡ nhé.
Code chạy Ok rồi.
giaiphap đã viết:
Bạn bị sai ở tất cả các lệnh cells(..., ...), do lệnh cells nó hiểu là sheet hiện tại. Để khắc phục bạn thử sửa lại code thế này.
Mã: 
Sub MoHinhMau()
Dim DesTemp As Range, Des As Range

On Error Resume Next
    Set DesTemp = Application.InputBox("Ch" & ChrW(7885) & "n ô t" & ChrW(7841) & _
        "o mô hình m" & ChrW(7851) & "u", "Mô hình m" & ChrW(7851) & _
        "u", Default:=ActiveWindow.ActiveCell.Address, Type:=8)

If Err.Number <> 0 Then Exit Sub

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

If IsArray(DesTemp) = True Then
   Set Des = DesTemp.Cells(1, 1)
Else
    Set Des = DesTemp
End If

With Des.Resize(11, 7)
    .Clear
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
End With
    With Des.Resize(9, 5)

        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
   
    With Des.Offset(10, 1).Resize(, 4)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Interior.Color = 65535
    End With
    With Des.Offset(2, 6).Resize(7)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Interior.Color = 65535
    End With
   
    With Des.Offset(3, 2).Resize(6, 3)
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlInsideVertical).Weight = xlMedium
        .Borders(xlInsideHorizontal).Weight = xlMedium
        .Interior.Color = 65280
    End With
   
    With Des.Resize(2, 1)
        .MergeCells = True
        .FormulaR1C1 = "Day"
        .Font.Bold = True
    End With
    With Des.Resize(11, 7)
        .Cells(1, 2).FormulaR1C1 = "L" & ChrW(432) & ChrW(7907) & "ng (Kg)"
        .Cells(1, 2).Font.Bold = True
        .Cells(1, 3).FormulaR1C1 = "10000"
        .Cells(1, 4).FormulaR1C1 = "4900"
        .Cells(1, 5).FormulaR1C1 = "4900"
        .Cells(2, 2).FormulaR1C1 = "Kho"
        .Cells(2, 2).Font.Bold = True
        .Cells(2, 3).FormulaR1C1 = "1250"
        .Cells(2, 4).FormulaR1C1 = "652"
        .Cells(2, 5).FormulaR1C1 = "590"
        .Cells(3, 1).FormulaR1C1 = "Yêu C" & ChrW(7847) & "u" & Chr(10) & "(Kg)"
        .Cells(3, 1).Font.Bold = True
        .Cells(3, 2).FormulaR1C1 = "So luong" & Chr(10) & "-----------" & "Tip"
   
        .Cells(3, 2).Font.Bold = True
        .Cells(3, 3).FormulaR1C1 = "2"
        .Cells(3, 4).FormulaR1C1 = "6"
        .Cells(3, 5).FormulaR1C1 = "8"
        .Cells(3, 7).FormulaR1C1 = "K" & ChrW(7871) & "t qu" & ChrW(7843)
        .Cells(3, 7).Font.Bold = True
        .Cells(4, 1).FormulaR1C1 = "4000"
        .Cells(4, 2).FormulaR1C1 = "91"
        .Cells(4, 3).FormulaR1C1 = "0"
        .Cells(4, 4).FormulaR1C1 = "1"
        .Cells(4, 5).FormulaR1C1 = "0"
        .Cells(4, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-3]C[-4]:R[-3]C[-2]*R[-1]C[-4]:R[-1]C[-2]*RC[-4]:RC[-2]/R[-2]C[-4]:R[-2]C[-2])"
        .Cells(5, 1).FormulaR1C1 = "2000"
        .Cells(5, 2).FormulaR1C1 = "127"
        .Cells(5, 3).FormulaR1C1 = "1"
        .Cells(5, 4).FormulaR1C1 = "0"
        .Cells(5, 5).FormulaR1C1 = "0"
        .Cells(5, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-4]C[-4]:R[-4]C[-2]*R[-2]C[-4]:R[-2]C[-2]*RC[-4]:RC[-2]/R[-3]C[-4]:R[-3]C[-2])"
        .Cells(6, 1).FormulaR1C1 = "25000"
        .Cells(6, 2).FormulaR1C1 = "153"
        .Cells(6, 3).FormulaR1C1 = "2"
        .Cells(6, 4).FormulaR1C1 = "0"
        .Cells(6, 5).FormulaR1C1 = "2"
        .Cells(6, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-5]C[-4]:R[-5]C[-2]*R[-3]C[-4]:R[-3]C[-2]*RC[-4]:RC[-2]/R[-4]C[-4]:R[-4]C[-2])"
        .Cells(7, 1).FormulaR1C1 = "5200"
        .Cells(7, 2).FormulaR1C1 = "173"
        .Cells(7, 3).FormulaR1C1 = "2"
        .Cells(7, 4).FormulaR1C1 = "0"
        .Cells(7, 5).FormulaR1C1 = "0"
        .Cells(7, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-6]C[-4]:R[-6]C[-2]*R[-4]C[-4]:R[-4]C[-2]*RC[-4]:RC[-2]/R[-5]C[-4]:R[-5]C[-2])"
        .Cells(8, 1).FormulaR1C1 = "7200"
        .Cells(8, 2).FormulaR1C1 = "233"
        .Cells(8, 3).FormulaR1C1 = "2"
        .Cells(8, 4).FormulaR1C1 = "0"
        .Cells(8, 5).FormulaR1C1 = "0"
        .Cells(8, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-7]C[-4]:R[-7]C[-2]*R[-5]C[-4]:R[-5]C[-2]*RC[-4]:RC[-2]/R[-6]C[-4]:R[-6]C[-2])"
        .Cells(9, 1).FormulaR1C1 = "42000"
        .Cells(9, 2).FormulaR1C1 = "277"
        .Cells(9, 3).FormulaR1C1 = "0"
        .Cells(9, 4).FormulaR1C1 = "2"
        .Cells(9, 5).FormulaR1C1 = "1"
        .Cells(9, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-8]C[-4]:R[-8]C[-2]*R[-6]C[-4]:R[-6]C[-2]*RC[-4]:RC[-2]/R[-7]C[-4]:R[-7]C[-2])"
        .Cells(11, 2).FormulaR1C1 = "Thua"
        .Cells(11, 2).Font.Bold = True
        .Cells(11, 3).FormulaR1C1 = "=R[-9]C-SUMPRODUCT(R[-7]C[-1]:R[-2]C[-1]*R[-7]C:R[-2]C)"
        .Cells(11, 4).FormulaR1C1 = "=R[-9]C-SUMPRODUCT(R[-7]C[-2]:R[-2]C[-2]*R[-7]C:R[-2]C)"
        .Cells(11, 5).FormulaR1C1 = "=R[-9]C-SUMPRODUCT(R[-7]C[-3]:R[-2]C[-3]*R[-7]C:R[-2]C)"
        .Columns.AutoFit
        .Rows.AutoFit
        .Columns(6).EntireColumn.ColumnWidth = 3
    End With
    Des.Offset(, 2).Resize(, 3).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
    Des.Offset(2).Resize(6).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
    Des.Offset(2, 6).Resize(6).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = False

End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn đã giúp đỡ
Code chạy Ok rồi.
 
Upvote 0
Bạn biết mục đích code ấy nó làm cái gì hôn? (không đi theo cái file áp dụng thì mục đích rỗng tuếch)
Người viết code lúc ấy chỉ có 1 mục đích chính trong đầu: từ dữ kiện đầu vào như thế, đạt yêu cầu đầu ra như này, với tốc độ nhanh nhất. Hết.
Nó không phải là loại code viết để người khác tìm hiểu và học hỏi.
 
Upvote 0
VetMini đã viết:
Bạn biết mục đích code ấy nó làm cái gì hôn? (không đi theo cái file áp dụng thì mục đích rỗng tuếch)
Người viết code lúc ấy chỉ có 1 mục đích chính trong đầu: từ dữ kiện đầu vào như thế, đạt yêu cầu đầu ra như này, với tốc độ nhanh nhất. Hết.
Nó không phải là loại code viết để người khác tìm hiểu và học hỏi.
Nhấp chuột vào đây để mở rộng...
mình đã kèm file theo đính kèm, mình vẫn ko hiểu ý bạn. ( Nó không phải là loại code viết để người khác tìm hiểu và học hỏi. ). Mình biết nó cao siêu, nhưng ko biết thì mĩnh vẫn hỏi tại nó cần cho công việc của mình..Thank bạn đã góp ý
 
Upvote 0
nguyenthotnot đã viết:
Chào các anh chị: Em có đoạn code của GPE em mới đang học VBA em coppy đoạn code về phục vụ cho công việc của em nhưng em vẫn ko hiểu ý nghĩa của các đoạn code sau mong các anh chị có thể giải thích cặn kẽ giúp em với tại sao mình khai báo là biến sArr() và dArr(), fDate, eDate, Rws, Col, với các mục tô màu đỏ mong các anh chị giúp em hiểu ý nghĩa với thank các anh chị biến J,K,R mình có thể khai báo biến khác được ko các anh chị
Public Sub Gpe_Loc()
Dim sArr(), dArr(), i As Long, J As Long, K As Long, R As Long, Rws As Long, Col As Long, fDate As Long, eDate As Long, SName As String
SName = Range("C5").Value
fDate = Range("C6").Value
eDate = IIf(Range("C7").Value = Empty, Date, Range("C7").Value)
sohd = "*" & UCase(Range("E6").Value) & "*"
Col = 57
With Sheets(SName)
R = .Range("B10000").End(xlUp).Row
If R > 8 Then
sArr = .Range("A9:A" & R).Resize(, Col).Value
Rws = UBound(sArr)
ReDim dArr(1 To R, 1 To Col)
For i = 1 To Rws
If sArr(i, 2) >= fDate Then
If sArr(i, 2) <= eDate Then
If UCase(sArr(i, 3)) Like UCase(sohd) Then
K = K + 1
dArr(K, 1) = K
For J = 2 To Col
dArr(K, J) = sArr(i, J)
Next J
End If
End If
End If
End With
Range("A9").Resize(1000, Col).ClearContents
If K Then Range("A9").Resize(K, Col) = dArr
End Sub

public Sub Gpe_TH()
Dim sArr(), dArr(), Col(), tArr(), Ngay As Date, ShName As String
Dim C As Long, i As Long, J As Long, K As Long, n As Long, R As Long, Rws As Long
Ngay = Range("C4").Value
Col = Range("D8:Z8").Value
C = UBound(Col, 2)
tArr = Range("C9", Range("C9").End(xlDown)).Value
ReDim dArr(1 To UBound(tArr), 1 To C)
For n = 1 To UBound(tArr)
ShName = tArr(n, 1)
With Sheets(ShName)
R = .Range("B50000").End(xlUp).Row
If R > 8 Then
sArr = .Range("A9:B" & R).Resize(, 57).Value
Rws = UBound(sArr)
For i = Rws To 1 Step -1
If sArr(i, 2) <= Ngay Then
For J = 1 To C
If Col(1, J) <> Empty Then dArr(n, J) = sArr(i, Col(1, J))
Next J
Exit For
End If
Next i
End If
End With
Next n
Range("D9").Resize(1000, C).ClearContents
Range("D9").Resize(n - 1, C) = dArr
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$4" Then Gpe_TH
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C5:K7")) Is Nothing Then Gpe_Loc
End Sub

em xin kèm theo file đính kèm mong các anh chị chỉ giúp đỡ dùm
Nhấp chuột vào đây để mở rộng...
Đến biến bạn còn không biết ý nghĩa của nó thì làm sao mà hiểu được code.Bạn phải hiểu cơ bản rồi mới tìm hiểu thêm.Bạn đọc tài liệu mảng xong vào tìm hiểu code này nhé.
 
Upvote 0
Nhờ các bạn giúp mình sửa lỗi trong file này với ah, chạy VBA báo lỗi mình chưa biết xử lý thế nào, thanks
 

File đính kèm

  • testcdsp.xlsm
    54.9 KB · Đọc: 3
Upvote 0
luanvm123 đã viết:
Nhờ các bạn giúp mình sửa lỗi trong file này với ah, chạy VBA báo lỗi mình chưa biết xử lý thế nào, Cảm ơn
Nhấp chuột vào đây để mở rộng...
Thêm câu lệnh này nữa.Đó trước câu ở dưới.
Mã: 
Sheet2.Activate
 Sheet2.Range(Cells(3, 4 + 28 * (a - 1)), Cells(3, 28 * a + 4)) = "T" & a
 
Upvote 0
Gửi các anh chị. Em mới tự học và làm thử code trên file excel công việc của em. Có đoạn code tự làm này mà không hiểu sao nó làm file của em tính toán chậm quá ạ. Mọi người giúp em khắc phục được không ạ
Nhập tháng làm việc
Mã: 
Private Sub Workbook_Open()
Dim thang As Integer
Dim nam As Integer
Application.Calculation = xlCalculationManual
On Error Resume Next
thang = InputBox("chon thang lam viec", , Month(Date))
On Error GoTo 0
Sheets("th").Range("y1").Value = thang
If thang > 12 Or thang <= 0 Then
   MsgBox "Chua chon thang", vbCritical
   Sheets("th").Range("y1").Value = Month(Date)
End If
On Error Resume Next
nam = InputBox("chon nam lam viec", , Year(Date))
On Error GoTo 0
Sheets("th").Range("z1").Value = nam
If nam <= 2007 Then
   MsgBox "Chua chon nam", vbCritical
   Sheets("th").Range("z1").Value = Year(Date)
End If
Application.Calculation = xlCalculationAutomatic
End Sub
Module1:
Mã: 
Function thanglmv() As Date
Application.Volatile
thanglmv = DateSerial(Sheets("th").Range("z1").Value, Sheets("th").Range("y1").Value, 15)
End Function
Code này em dùng để nhập tháng làm việc sau đó lấy hàm lấy ngày tháng làm việc đó dùng trong công thức khoảng 300 dòng.
 
Upvote 0
Xin giúp đỡ về vòng lặp For..Next
Mã: 
Sub tinhdinhluong()
Dim i, j, a, b
For i = 4 To 1500 'lay ten model sheet B.O.M
     For a = 6 To 50 'so sanh ten model o sheet 8
         For j = 4 To 1500 'lay code o sheet B.O.M
             For b = 7 To 650
              If Sheet2.Cells(i, 2).Value = Sheet8.Cells(5, a).Value And Sheet2.Cells(j, 3).Value = Sheet8.Cells(b, 3).Value Then
              Sheet8.Cells(b, a).Value = Sheet2.Cells(j, 9).Value
              End If
             Next b
         Next j
     Next a
Next i
End Sub
sau khi em chạy thì file bị dow, xin các anh chị giúp đỡ ạ
 
Upvote 0
duonghychi đã viết:
Xin giúp đỡ về vòng lặp For..Next
Mã: 
Sub tinhdinhluong()
Dim i, j, a, b
For i = 4 To 1500 'lay ten model sheet B.O.M
     For a = 6 To 50 'so sanh ten model o sheet 8
         For j = 4 To 1500 'lay code o sheet B.O.M
             For b = 7 To 650
              If Sheet2.Cells(i, 2).Value = Sheet8.Cells(5, a).Value And Sheet2.Cells(j, 3).Value = Sheet8.Cells(b, 3).Value Then
              Sheet8.Cells(b, a).Value = Sheet2.Cells(j, 9).Value
              End If
             Next b
         Next j
     Next a
Next i
End Sub
sau khi em chạy thì file bị dow, xin các anh chị giúp đỡ ạ
Nhấp chuột vào đây để mở rộng...
Theo kết quả mình tính sơ bộ thì cần:63.317.948.672 vòng lặp để chạy xong 4 vòng lặp For của bạn chưa tính đến chuyện sử lý số liệu.Máy nó chạy cũng hết hơi.
​
 
Upvote 0
em muốn ở sheet "CHIA BTP" sẽ lấy giá trị ở cột "QTY" tại sheet B.O.M ạ, xin bác giúp đỡ
 

File đính kèm

  • Check NVL CL (1) (Tự_lưu).xlsm
    1.2 MB · Đọc: 3
  • Check NVL CL (1) (Tự_lưu).xlsm
    1.2 MB · Đọc: 4
Upvote 0
duonghychi đã viết:
em muốn ở sheet "CHIA BTP" sẽ lấy giá trị ở cột "QTY" tại sheet B.O.M ạ, xin bác giúp đỡ
Nhấp chuột vào đây để mở rộng...
Bạn thử nhé.
Mã: 
Sub tinh()
    Dim arr, i As Long, j As Long, data, lr As Long, dic As Object, a As Long, b As Long, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("CHIA BTP")
         lr = .Range("C" & Rows.Count).End(xlUp).Row
         If lr < 7 Then Exit Sub
         .Range("F7:AJ" & lr).ClearContents
         arr = .Range("C4:AJ" & lr).Value
         For i = 4 To UBound(arr)
             dk = arr(i, 1) & "#" & "I"
             dic.Item(dk) = i
         Next i
         For i = 4 To UBound(arr, 2)
             dk = arr(2, i) & "#" & "M"
             dic.Item(dk) = i
         Next i
   End With
   With Sheets("B.O.M")
      j = .Range("B" & Rows.Count).End(xlUp).Row
      data = .Range("B4:I" & j).Value
      For i = 1 To UBound(data)
              dk = data(i, 1) & "#" & "M"
              a = dic.Item(dk)
              If a Then
                 dk = data(i, 2) & "#" & "I"
                 b = dic.Item(dk)
                 If b Then
                    arr(b, a) = arr(b, a) + data(i, 8)
                 End If
             End If
     Next i
  End With
  With Sheets("CHIA BTP")
       .Range("C4:AJ" & lr).Value = arr
  End With
End Sub
 
Upvote 0
snow25 đã viết:
Bạn thử nhé.
Mã: 
Sub tinh()
    Dim arr, i As Long, j As Long, data, lr As Long, dic As Object, a As Long, b As Long, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("CHIA BTP")
         lr = .Range("C" & Rows.Count).End(xlUp).Row
         If lr < 7 Then Exit Sub
         .Range("F7:AJ" & lr).ClearContents
         arr = .Range("C4:AJ" & lr).Value
         For i = 4 To UBound(arr)
             dk = arr(i, 1) & "#" & "I"
             dic.Item(dk) = i
         Next i
         For i = 4 To UBound(arr, 2)
             dk = arr(2, i) & "#" & "M"
             dic.Item(dk) = i
         Next i
   End With
   With Sheets("B.O.M")
      j = .Range("B" & Rows.Count).End(xlUp).Row
      data = .Range("B4:I" & j).Value
      For i = 1 To UBound(data)
              dk = data(i, 1) & "#" & "M"
              a = dic.Item(dk)
              If a Then
                 dk = data(i, 2) & "#" & "I"
                 b = dic.Item(dk)
                 If b Then
                    arr(b, a) = arr(b, a) + data(i, 8)
                 End If
             End If
     Next i
  End With
  With Sheets("CHIA BTP")
       .Range("C4:AJ" & lr).Value = arr
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
Em cảm ơn ạ, bác giúp em 1 xíu nữa là em muốn nhân các giá trị tìm kiếm được cho số lượng ở dòng 6, dưới mỗi tên model thì làm như thế nào ạ.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

A
Excel thiếu dữ liệu
Trả lời
4
Đọc
75
Mr.hieudoanxd
Mr.hieudoanxd
H
  • Question
Code subtotal và tìm điều kiện
Trả lời
11
Đọc
186
Hoàng Tuấn 868
H
S
Nhờ giúp đỡ code in toàn bộ danh sách có điều kiện
Trả lời
1
Đọc
32
BuiQuangThuan
B
A
Đếm dữ liệu với điều kiện
Trả lời
11
Đọc
97
DeTong
D
Maika8008
  • Question
Add-In .xlam trộn dữ liệu Excel vào Word
    • Thích
    • Yêu thích
    • Cảm ơn
2
Trả lời
29
Đọc
2K
vu_tuan_manh_linh
vu_tuan_manh_linh
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom