Nhờ viết code cho bảng tổng hợp nhập xuất tồn có nhiều nhóm hàng. (1 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)
T

tranthanhktt

Thành viên chính thức
Tham gia
7/9/10
Bài viết
55
Được thích
20
Chào các bạn ! mình đang gặp chút vấn đề trong file nhập xuất tồn kho, vì file có rất nhiều công thức nên rất nặng, mình đang chuyển qua sử dụng bằng vba nhưng mà chưa biết viết code cho bảng tổng hợp NXT cónhiềunhómhàng như thế nào. Rất mong các bạn giúp đỡ . Cám ơn nhiều.
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
Bạn thử lấy cập macro này thay cho macro PN() của bạn xem sao

. . . nên bạn có phát hiện sai chỗ nào góp ý dùm để fie chay ok hơn. Cámơn
Nhấp chuột vào đây để mở rộng...

PHP: 
Sub PN()
 Dim i, HC, t As Long
 Dim TKNo As Range
 Dim TK As String
 Sheets("pn").Select
 Range("A13:J65536").Clear
 Application.Calculation = xlCalculationManual
 Application.ScreenUpdating = False
    
 TK = Range("D6").Value
 HC = Sheets("PHATSINH").Range("b60000").End(xlUp).Row
 i = 12:                        t = 0
 For Each TKNo In Sheets("PHATSINH").Range("b7:b" & HC)
    If TKNo.Offset(0, 3) = TK Then
        i = i + 1:                  t = t + 1
        Range("A" & i) = t
        Range("B" & i) = TKNo.Offset(0, 1)
        Range("C" & i) = TKNo
        Range("D" & i) = TKNo.Offset(0, 2)
        Range("E" & i) = TKNo.Offset(0, 14)
        Range("F" & i) = TKNo.Offset(0, 14)
        Range("g" & i) = TKNo.Offset(0, 17)
        Range("H" & i).Formula = "=rc[-1]*rc[-2]"
    End If
 Next TKNo
 If i = 13 Then
    Set TKNo = Nothing
    Range("g13:h" & i).NumberFormat = "###,00"
    Range("A13 :h" & i).Font.Size = 11
    Range("A13:h" & i).VerticalAlignment = xlCenter
    Range("A13:h" & i + 1).WrapText = True
    Range("A13:h" & i + 7).Font.Name = "arial"
    Range("A" & i + 1 & ":h" & i + 7).Font.ColorIndex = 5
    Range("A" & i + 1 & ":h" & i + 1).Font.Bold = True
    Range("A" & i + 1 & ":h" & i + 1).Interior.ColorIndex = 20
    Range("B" & i + 2).Value = "=doc & vnd(r[-1]c[6])"
    Range("B" & i + 2).Font.Italic = True
    Range("B" & i + 2).Font.Name = "VNI-TIMES"
    Range("E" & i + 4).Value = Sheets("THONGTIN").Range("A22").Value
    Range("B" & i + 3).Value = Sheets("THONGTIN").Range("A14")
    Range("B" & i + 5).Value = Sheets("THONGTIN").Range("A15")
    Range("C" & i + 5).Value = Sheets("THONGTIN").Range("A19")
    Range("E" & i + 5).Value = Sheets("THONGTIN").Range("A16")
    Range("G" & i + 5).Value = Sheets("THONGTIN").Range("A17")
    Range("b" & i + 1).Value = Sheets("THONGTIN").Range("A20")
    Range("H" & i + 1).Formula = "=round(SUM(R13C:R" & i & "C),0)"
    Range("b" & i + 1).HorizontalAlignment = xlCenter
    Range("B" & i + 2 & ":h" & i + 2).MergeCells = True
    Range("B" & i + 2 & ":h" & i + 2).WrapText = True
    Range("B" & i + 2 & ":h" & i + 2).VerticalAlignment = xlCenter
    Range("b" & i + 1).HorizontalAlignment = xlCenter
    Range("C13:f" & i + 1).HorizontalAlignment = xlCenter
    Range("g" & i + 5 & ":h" & i + 5).MergeCells = True
    Range("g" & i + 5 & ":h" & i + 5).HorizontalAlignment = xlCenter
    Range("e" & i + 4 & ":h" & i + 4).HorizontalAlignment = xlCenter
    Range("e" & i + 4 & ":h" & i + 4).MergeCells = True
             
    FormatLines Range("A13:h" & i)
'    Range("A13:h" & i).Borders(xlEdgeLeft).LineStyle = xlContinuous 7'
'    Range("A13:h" & i).Borders(xlEdgeRight).LineStyle = xlContinuous 10'
'    Range("A13:h" & i).Borders(xlEdgeBottom).LineStyle = xlContinuous 9'
'    Range("A13:h" & i).Borders(xlEdgeTop).LineStyle = xlContinuous 8'
'    Range("A13:h" & i).Borders(xlInsideVertical).LineStyle = xlContinuous 11'
    FormatLines Range("A13:h" & i + 1)
         
 End If
 If i > 13 Then
    Set TKNo = Nothing
    Range("g13:h" & i).NumberFormat = "###,00"
    Range("A13 :h" & i).Font.Size = 11
    Range("A13:h" & i).VerticalAlignment = xlCenter
    Range("A13:h" & i + 1).WrapText = True
    Range("A13:h" & i + 7).Font.Name = "arial"
    Range("A" & i + 1 & ":h" & i + 7).Font.ColorIndex = 5
    Range("A" & i + 1 & ":h" & i + 1).Font.Bold = True
    Range("A" & i + 1 & ":h" & i + 1).Interior.ColorIndex = 20
    Range("B" & i + 2).Value = "=doc & vnd(r[-1]c[6])"
    Range("B" & i + 2).Font.Italic = True
    Range("B" & i + 2).Font.Name = "VNI-TIMES"
    Range("E" & i + 4).Value = Sheets("THONGTIN").Range("A22").Value
    Range("B" & i + 3).Value = Sheets("THONGTIN").Range("A14")
    Range("B" & i + 5).Value = Sheets("THONGTIN").Range("A15")
    Range("C" & i + 5).Value = Sheets("THONGTIN").Range("A19")
    Range("E" & i + 5).Value = Sheets("THONGTIN").Range("A16")
    Range("G" & i + 5).Value = Sheets("THONGTIN").Range("A17")
    Range("b" & i + 1).Value = Sheets("THONGTIN").Range("A20")
    Range("H" & i + 1).Formula = "=round(SUM(R13C:R" & i & "C),0)"
    Range("b" & i + 1).HorizontalAlignment = xlCenter
    Range("B" & i + 2 & ":h" & i + 2).MergeCells = True
    Range("B" & i + 2 & ":h" & i + 2).WrapText = True
    Range("B" & i + 2 & ":h" & i + 2).VerticalAlignment = xlCenter
    Range("b" & i + 1).HorizontalAlignment = xlCenter
    Range("C13:f" & i + 1).HorizontalAlignment = xlCenter
    Range("g" & i + 5 & ":h" & i + 5).MergeCells = True
    Range("g" & i + 5 & ":h" & i + 5).HorizontalAlignment = xlCenter
    Range("e" & i + 4 & ":h" & i + 4).HorizontalAlignment = xlCenter
    Range("e" & i + 4 & ":h" & i + 4).MergeCells = True
                      
    FormatLines Range("A13:h" & i)
    Range("A13:h" & i).Borders(xlInsideHorizontal).LineStyle = xlDot '12'
    
    FormatLines Range("A13:h" & i + 1)
                                       
 End If
 If i < 13 Then
    MsgBox " Um! khong phat sinh so phieu tren!", , "thongbao": Exit Sub
 End If
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
                   
End Sub

Mã: 
[B]
Sub FormatLines(Rng As Range)[/B]
 Dim jJ As Byte
 
 For jJ = 7 To 11
    Rng.Borders(jJ).LineStyle = xlContinuous
 Next jJ[B]
End Sub[/B]
 
Upvote 0
uhm! mình không để ý code dưới . hay đấy mình học them được một chiêu nữa. cámơn bạn
 
Upvote 0
Thêm 1 macro nữa cho bạn trước khi đi ngủ

PHP: 
Option Explicit
Const r0 As Long = 4007
Private Sub CommandButton1_Click()
 Dim Sh As Worksheet, Cls As Range, Rng As Range, sRng As Range
 Dim MyAdd As String
 Dim HC As Long
 
 With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
 End With
 Set Sh = ThisWorkbook.Worksheets("Ma")
 Rows("8:" & r0).Hidden = False
 Rows("8:" & r0).Clear
 Set Rng = Sh.Range(Sh.[A5], Sh.[A5].End(xlDown))
 
 For Each Cls In Sh.Range(Sh.[p3], Sh.[p3].End(xlDown))
    With Cells(r0, "A").End(xlUp).Offset(1)
        .Resize(, 2).Value = Cls.Resize(, 2).Value
        .Resize(, 13).Interior.ColorIndex = 20
        .Resize(, 13).Font.Bold = True
        .Resize(, 13).Font.ColorIndex = 5
    End With
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlPart)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            If Left(sRng.Value, 3) = Cls.Value Then
                sRng.Resize(, 3).Copy Destination:=Cells(r0, "A").End(xlUp).Offset(1)
            End If
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
  Next Cls
  
  Set Sh = ThisWorkbook.Sheets("LAILO")
  HC = Sh.Range("A60000").End(xlUp).Row
  
'  With Rng'
    Sh.Range("D8:M" & HC + 1).NumberFormat = "#,##0"
    Sh.Range("A8:M" & HC + 10).Font.Name = "arial"
    Sh.Range("A8:M" & HC).Font.ColorIndex = 11
    Sh.Range("A8:M" & HC).Font.Size = 11
    Sh.Range("A8:M" & HC).VerticalAlignment = xlCenter
    Sh.Range("A" & HC + 1 & ":m" & HC + 1).HorizontalAlignment = xlCenter
    Sh.Range("A" & HC + 1 & ":m" & HC + 1).Font.Bold = True
    Sh.Range("A" & HC + 1 & ":m" & HC + 1).Font.Size = 11
    Sh.Range("A" & HC + 1 & ":m" & HC + 1).Interior.ColorIndex = 20
    Sh.Range("A" & HC + 1 & ":m" & HC + 8).Font.ColorIndex = 5
    ActiveSheet.Range("B" & HC + 1).Value = Sheets("temp").Range("a1")
    Sh.Range("b" & HC + 4) = Sheets("thongtin").Range("a15").Value
    Sh.Range("f" & HC + 4) = Sheets("thongtin").Range("a16").Value
    Sh.Range("k" & HC + 4) = Sheets("thongtin").Range("a17").Value
    Sh.Range("k" & HC + 3) = Sheets("thongtin").Range("a23").Value
    Sh.Range("k" & HC + 4 & ":m" & HC + 4).MergeCells = True
    Sh.Range("k" & HC + 3 & ":m" & HC + 3).MergeCells = True
    Sh.Range("k" & HC + 4 & ":m" & HC + 4).HorizontalAlignment = xlCenter
    Sh.Range("k" & HC + 3 & ":m" & HC + 3).HorizontalAlignment = xlCenter
    Range("d8:d" & HC).FormulaR1C1 = "=SUMPRODUCT((maps=RC[-3])*(ngayct>=R3C3)*(ngayct<=R3C7)*(lgBAN))"
    Range("e8:e" & HC).FormulaR1C1 = "=IF(RC[-1]=0,0,RC[1]/RC[-1])"
    Range("F8:F" & HC).FormulaR1C1 = "=SUMPRODUCT((maps=RC[-5])*(ngayct>=R3C3)*(ngayct<=R3C7)*(TIENBAN))"
    Range("j8:j" & HC).FormulaR1C1 = "=RC[-4]-RC[-3]-RC[-2]-RC[-1]"
    Range("K8:K" & HC).FormulaR1C1 = "=SUMPRODUCT((maps=RC[-10])*(ngayct>=R3C3)*(ngayct<=R3C7)*(TIENxuat))"
    Range("L8:L" & HC).FormulaR1C1 = "=MAX(RC[-2]-RC[-1],0)"
    Range("M8:M" & HC).FormulaR1C1 = "=MAX(RC[-2]-RC[-3],0)"
    'Tinh so du cuoi ky'
    Range("f" & HC + 1).Value = "=SUM(R7C:R" & HC & "C)"
    Range("g" & HC + 1).Value = "=SUM(R7C:R" & HC & "C)"
    Range("h" & HC + 1).Value = "=SUM(R7C:R" & HC & "C)" 'doc so phat sinh trong ky'
    Range("i" & HC + 1).Value = "=SUM(R7C:R" & HC & "C)"
    Range("j" & HC + 1).Value = "=SUM(R7C:R" & HC & "C)"
    Range("k" & HC + 1).Value = "=SUM(R7C:R" & HC & "C)"
    Range("L" & HC + 1).Value = "=SUM(R7C:R" & HC & "C)"
    Range("M" & HC + 1).Value = "=SUM(R7C:R" & HC & "C)"
    'Range("E7:K217").Value = Range("E7:K217").Value'
' End With'
' With Rng'
    FormatLines Sh.Range("A8:M" & HC)
    
    Sh.Range("A8:M" & HC).Borders(xlInsideHorizontal).LineStyle = xlDot
    FormatLines Sh.Range("A" & HC + 1 & ":M" & HC + 1)
    
'    Sh.Range("A" & HC + 1 & ":M" & HC + 1).Borders(xlEdgeLeft).LineStyle = xlContinuous'
'    Sh.Range("A" & HC + 1 & ":M" & HC + 1).Borders(xlEdgeRight).LineStyle = xlContinuous'
'    Sh.Range("A" & HC + 1 & ":M" & HC + 1).Borders(xlEdgeBottom).LineStyle = xlContinuous'
'    Sh.Range("A" & HC + 1 & ":M" & HC + 1).Borders(xlEdgeTop).LineStyle = xlContinuous'
'    Sh.Range("A" & HC + 1 & ":M" & HC + 1).Borders(xlInsideVertical).LineStyle = xlContinuous'
    
 'End With'
 MsgBox "Da lap xong", , "thongbao"

 Application.Calculation = xlCalculationAutomatic
    
End Sub
 
Upvote 0
uhm! làm vậy nhìn code do ruom ra, hay lém. Nhưng không hiểu sao file cũng không nhiều công thức lắm mà nó chạy cùng hơi rùa hả bạn?
 
Upvote 0
Giờ mình hướng dẫn bạn từ xa, bạn tự sửa 1 macro để bạn tạo dần thói quen tốt

Macro đó của bạn có tên là Public Sub Lapsoct()

Đầu tiên bạn nên thêm dòng lệnh này bên trên dòng trên: option explicit
Tên macro nên đổi thành LapSoCT ;

Sau khi bạn thêm dòng lệnh trên, giờ bạn bấm vô trình biên dịch Compile VBAProject có trên menu Debug VBE sẽ đưa ta đến những lỗi biến chưa khai báo;

Hễ biến nào ta chưa khai báo, thì nên khai báo thêm vô tại 3 dòng lệnh có từ khoá Dim; Thực hiện việc này cho đến khi trình biên dịch không còn báo lỗi;

Sau tiếp, ta nên chép 3 dòng lệnh chứa Dim này lên ngay dưới tên macro;

Trong các dòng lệnh của bạn có hằng hà cụm từ "Sheets("CHITIET")." mà ta có thể bỏ hầu hết chúng, chỉ cần chỉnh dòng lệnh
Mã: 
 Sheets("CHITIET").Range("A13").Select
thành dòng lệnh
PHP: 
Sheets("CHITIET").Select

Kể từ sau dòng lệnh này, ta có toàn quyền bỏ cụm từ nêu trên;

Bạn cũng đã tực hiện việc thụt đầu dòng các dòng lệnh; Nhưng cách của bạn chỉ tổ thêm rối mắt.

Bạn thấy trên thanh công cụ VBE có ngăn hơi lớn ghi vị trí c on trỏ không?
(Như Ln 7, Col 35,. . . ); Bạn nên xài cái này để giúp bạn đỡ sai sót khi viết các câu lệnh;
Iêu cầu khắc khe của mình là For jJ . . . . thì fải có Next jJ
Điều này đôi lúc rất có lợi, 1 khi ta muốn xài biến Jj sau đó vào việc khác; (Khi thấy câu lệnh Next jJ là ta chắc rằng biến Jj đã hết xài bên trên)
Ta cần làm sao cho 'F' trong câu lệnh For Jj= 9 to 13 luôn trùng cột với 'N' trong câu Next jJ của 1 vòng lặp cụ thể nào đó.
Bạn hãy thực hiện các việc này tự ên nếu ưng cái bụng;
Ta sẽ tiếp 1 khi bạn sẽ đưa nội dung macro này lên sau khi đã chỉnh sửa!

Tạm biệt!
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Như vậy đúng không bạn?
Option Explicit
Public Sub LapSoCT()
Dim i, HC, m, x, y, j, z As Long
Dim TKNo As Range
Dim TK As String
Sheets("CHITIET").Select
Range("A13:o65536").Clear
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
TK = Left(Sheets("CHITIET").Range("b8"), 20)
m = Len(Sheets("CHITIET").Range("b8"))
HC = Sheets("PHATSINH").Range("b60000").End(xlUp).Row
i = 12
For Each TKNo In Sheets("PHATSINH").Range("B8:B" & HC)
If TKNo.Offset(0, 7) <= Sheets("chitiet").Range("h4").Value And Len(TKNo) > 3 Then
If Left(TKNo, m) = TK Then
If TKNo.Offset(0, 7).Value < Sheets("CHITIET").Range("e4").Value Then ' Ngay nho hon
x = x + TKNo.Offset(0, 20).Value
j = j + TKNo.Offset(0, 14).Value
Else ' Phat Sinh
i = i + 1
Range("A" & i) = TKNo.Offset(0, 3)
Range("B" & i) = TKNo.Offset(0, 4)
Range("C" & i) = TKNo.Offset(0, 7)
Range("D" & i) = TKNo.Offset(0, 11)
Range("E" & i) = TKNo.Offset(0, 12)
Range("F" & i) = TKNo.Offset(0, 2)
Range("G" & i) = TKNo.Offset(0, 17)
Range("H" & i) = TKNo.Offset(0, 18)
Range("I" & i) = TKNo.Offset(0, 14)
Range("J" & i) = TKNo.Offset(0, 20)
Range("K" & i) = TKNo.Offset(0, 15)
Range("L" & i) = TKNo.Offset(0, 21)
Range("m" & i).FormulaR1C1 = "=IF(RC[-4]+RC[-2]=0,0,R12C+SUM(R13C[-4]:R" & i & "C[-4])-SUM(R13C[-2]:R" & i & "C[-2]))"
Range("N" & i).FormulaR1C1 = "=IF(RC[-4]+RC[-2]=0,0,R12C+SUM(R13C[-4]:R" & i & "C[-4])-SUM(R13C[-2]:R" & i & "C[-2]))"
End If
End If
End If
If TKNo.Offset(0, 7) <= Sheets("chitiet").Range("h4").Value And Len(TKNo) > 3 Then
If Left(TKNo, m) = TK Then
If TKNo.Offset(0, 7).Value < Sheets("CHITIET").Range("e4").Value Then ' Ngay nho hon
y = y + TKNo.Offset(0, 21).Value
z = z + TKNo.Offset(0, 15).Value
End If
End If
End If
Next TKNo
Sheets("CHITIET").Range("M12").Value = WorksheetFunction.SumIf(Sheets("ma").Range("A5:A20000"), Sheets("CHITIET").Range("B8"), Sheets("MA").Range("e5:e20000")) + j - z
Sheets("CHITIET").Range("N12").Value = WorksheetFunction.SumIf(Sheets("MA").Range("A5:A20000"), Sheets("CHITIET").Range("B8"), Sheets("MA").Range("f5:f20000")) + x - y
Set TKNo = Nothing
If i = 13 Then
Range("C13", "C" & i).NumberFormat = "dd/mm/yy"
Range("G13:N" & i + 1).NumberFormat = "#,##0"
Range("A13 :O" & i).Font.Size = 11
Range("A" & i + 1 & ":O" & i + 7).Font.Size = 12
Range("A13:O" & i).VerticalAlignment = xlCenter
Range("A13:O" & i).WrapText = True
Range("A13:O" & i + 10).Font.Name = "Arial"
Range("I" & i + 1 & ":l" & i + 1).Formula = "=SUM(R13C:R" & i & "C)"
Range("m" & i + 1).Formula = "=R12C+RC[-4]-RC[-2]"
Range("N" & i + 1).Formula = "=R12C+RC[-4]-RC[-2]"
Range("D" & i + 1).Value = Sheets("thongtin").Range("a30")
Range("D" & i + 1).HorizontalAlignment = xlCenter
Range("A13:B" & i + 1).HorizontalAlignment = xlCenter
Range("E13:f" & i + 1).HorizontalAlignment = xlCenter
Range("A" & i + 1 & ":o" & i + 7).Font.ColorIndex = 5
Range("A" & i + 1 & ":O" & i + 7).Font.Bold = True
Range("A" & i + 1 & ":O" & i + 1).Interior.ColorIndex = 20
Range("A" & i + 1 & ":O" & i + 1).Font.ColorIndex = 5
Range("k" & i + 3).Value = Sheets("thongtin").Range("a23")
Range("k" & i + 3 & ":o" & i + 3).MergeCells = True
Range("k" & i + 3 & ":o" & i + 3).HorizontalAlignment = xlCenter
Range("k" & i + 4).Value = Sheets("thongtin").Range("a17")
Range("k" & i + 3).Font.Italic = True
Range("k" & i + 4 & ":o" & i + 4).MergeCells = True
Range("k" & i + 4 & ":o" & i + 4).HorizontalAlignment = xlCenter
Range("c" & i + 4).Value = Sheets("thongtin").Range("a15")
Range("g" & i + 4).Value = Sheets("thongtin").Range("a16")

FormatLines Range("A13:o" & i)
' Range("A13:o" & i).Borders(xlEdgeLeft).LineStyle = xlContinuous 7'
' Range("A13:o" & i).Borders(xlEdgeRight).LineStyle = xlContinuous 10'
' Range("A13:o" & i).Borders(xlEdgeBottom).LineStyle = xlContinuous 9'
' Range("A13:o" & i).Borders(xlEdgeTop).LineStyle = xlContinuous 8'
' Range("A13:o" & i).Borders(xlInsideVertical).LineStyle = xlContinuous 11'
FormatLines Range("A13:o" & i + 1)
End If
If i > 13 Then
Range("C13", "C" & i).NumberFormat = "dd/mm/yy"
Range("G13:N" & i + 1).NumberFormat = "#,##0"
Range("A13 :O" & i).Font.Size = 11
Range("A" & i + 1 & ":O" & i + 7).Font.Size = 12
Range("A13:O" & i).VerticalAlignment = xlCenter
Range("A13:O" & i).WrapText = True
Range("A13:O" & i + 10).Font.Name = "Arial"
Range("I" & i + 1 & ":l" & i + 1).Formula = "=SUM(R13C:R" & i & "C)"
Range("m" & i + 1).Formula = "=R12C+RC[-4]-RC[-2]"
Range("N" & i + 1).Formula = "=R12C+RC[-4]-RC[-2]"
Range("D" & i + 1).Value = Sheets("thongtin").Range("a30")
Range("D" & i + 1).HorizontalAlignment = xlCenter
Range("A13:B" & i + 1).HorizontalAlignment = xlCenter
Range("E13:f" & i + 1).HorizontalAlignment = xlCenter
Range("A" & i + 1 & ":o" & i + 7).Font.ColorIndex = 5
Range("A" & i + 1 & ":O" & i + 7).Font.Bold = True
Range("A" & i + 1 & ":O" & i + 1).Interior.ColorIndex = 20
Range("A" & i + 1 & ":O" & i + 1).Font.ColorIndex = 5
Range("k" & i + 3).Value = Sheets("thongtin").Range("a23")
Range("k" & i + 3 & ":o" & i + 3).MergeCells = True
Range("k" & i + 3 & ":o" & i + 3).HorizontalAlignment = xlCenter
Range("k" & i + 4).Value = Sheets("thongtin").Range("a17")
Range("k" & i + 3).Font.Italic = True
Range("k" & i + 4 & ":o" & i + 4).MergeCells = True
Range("k" & i + 4 & ":o" & i + 4).HorizontalAlignment = xlCenter
Range("c" & i + 4).Value = Sheets("thongtin").Range("a15")
Range("g" & i + 4).Value = Sheets("thongtin").Range("a16")
FormatLines Range("A13:o" & i)
Range("A13:o" & i).Borders(xlInsideHorizontal).LineStyle = xlDot '12'
FormatLines Range("A13:o" & i + 1)
End If
If i < 13 Then
MsgBox " Um! khong phat sinh !", , "thongbao": Exit Sub
End If
MsgBox " Da lap xong ", , "thongbao"
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub FormatLines(Rng As Range)
Dim jJ As Byte

For jJ = 7 To 11
Rng.Borders(jJ).LineStyle = xlContinuous
Next jJ
End Sub
 
Upvote 0
Chúng ta tiếp tục, nha

Còn 2 dòng lệnh dài nhất kia, ta có thể nên làm thế này

PHP: 
 '  *       *       *       *'
 Dim Sh As Worksheet, WF As Object
 Set Sh = ThisWorkbook.Worksheets("Ma")
 Set WF = Application.WorksheetFunction
 With Sheets("CHITIET")
    .Range("M12").Value = WF.SumIf(Sh.Range("A5:A20 000"), .Range("B8"), Sh.Range("e5:e20000")) + j - z
    .Range("N12").Value = WF.SumIf(Sh.Range("A5:A20 000"), .Range("B8"), Sh.Range("f5:f20000")) + x - y
 End With
 Set WF = Nothing:          Set Sh = Nothing
  '  *       *       *       *'

Đó là những cách ta làm ngắn câu lệnh;
Giờ mình vẽ cách để bạn gộp dòng lệnh, như sau:

Bạn có đoạn mã:
Mã: 
                Range("A" & i) = TKNo.Offset(0, 3)[COLOR=#0000ff] '*'[/COLOR]
                Range("B" & i) = TKNo.Offset(0, 4)[COLOR=#0000ff] '*'[/COLOR]
                Range("C" & i) = TKNo.Offset(0, 7)
                Range("D" & i) = TKNo.Offset(0, 11) '*'
                Range("E" & i) = TKNo.Offset(0, 12) '*'
                Range("F" & i) = TKNo.Offset(0, 2)
                Range("G" & i) = TKNo.Offset(0, 17) '*'
                Range("H" & i) = TKNo.Offset(0, 18) '*'
Thực ra 2 dòng lệnh theo từng cặp có đánh dấu có thể hoàn toàn gộp lại nhờ fương thức Resize(x,y)
Ví dụ:
PHP: 
                   Range("D" & i).Resize(,2) = TKNo.Offset(0, 11).Resize(,2) '*'


Còn đây là bài tập cho bạn:

Hãy gộp 2 dòng lệnh sau đây của bạn thành 1:

Mã: 
    Range("m" & i + 1).Formula = "=R12C+RC[-4]-RC[-2]"      '*'
    Range("N" & i + 1).Formula = "=R12C+RC[-4]-RC[-2]"      '*'


Chúc thành công!
 
Upvote 0
tranthanhktt đã viết:
Cám ơn bạn! Sau khi được bạn giúp và "lượm lặt" trên diễn đàn mình đã "chắp vá" được một chiếc "áo rách " dùng đỡ cho mùa đông ,mình đưa lên diễn đànđể các bạn cùngtham khảo. Do không phải dân chuyên về VBA nên code trong file còn sơ khai và lũng củng lém nên file còn khá nặng, đây chỉ là ý tưởng thôi, nhờ các bác cao thủ nếu có thể chỉnh sửa dùm để file chạy nhẹ hơn. chúc cả nhà vui vẻ
Nhấp chuột vào đây để mở rộng...

Mình muốn chỉnh sửa, xóa nhưng danh mục không cần thiết thì làm sao ? để phù hợp với ngành nghề kd của mình
 
Upvote 0
bạn muốn xóa danh mục nào? có thể đưa file lên đi mọi người cùng nghiên cứu
 
Upvote 0
tranthanhktt đã viết:
Cám ơn bạn! Sau khi được bạn giúp và "lượm lặt" trên diễn đàn mình đã "chắp vá" được một chiếc "áo rách " dùng đỡ cho mùa đông ,mình đưa lên diễn đànđể các bạn cùngtham khảo. Do không phải dân chuyên về VBA nên code trong file còn sơ khai và lũng củng lém nên file còn khá nặng, đây chỉ là ý tưởng thôi, nhờ các bác cao thủ nếu có thể chỉnh sửa dùm để file chạy nhẹ hơn. chúc cả nhà vui vẻ
Nhấp chuột vào đây để mở rộng...

Mình sau khi lượp lặt chỉnh sửa cho phù hợp với cv của mình, Nhờ bạn viết thành code bảng chạy như menu trong file của bạn dùm mình với!!!!!!!!!
 

File đính kèm

Upvote 0
Bạn chuển file sang EXcell 2003 đi máy mình không đọc được
 
Upvote 0
Thu mau XN hang

tranthanhktt đã viết:
Chào các bạn ! mình đang gặp chút vấn đề trong file nhập xuất tồn kho, vì file có rất nhiều công thức nên rất nặng, mình đang chuyển qua sử dụng bằng vba nhưng mà chưa biết viết code cho bảng tổng hợp NXT cónhiềunhómhàng như thế nào. Rất mong các bạn giúp đỡ . Cám ơn nhiều.
Nhấp chuột vào đây để mở rộng...


Gui ban, ben minh cung phai xuat nhap hang, co mau nay ban thu xem sao nhe.
 

File đính kèm

Upvote 0
/-)ề xuất gộp 2 macro

To TranThanhktt;383844
Nhấp chuột vào đây để mở rộng...

Mình thấy 2 macro PN() & PX() cuả bạn rất giống nhau, như 2 anh em sinh đôi;

Nên đề xuất việc gộp chung chúng trong 1 macro, giống như ta đặt thừa số chung vậy mà;

Bạn xem cách mình đưa 2 macro lên trang tính để so sánh (file kèm theo) & cho í kiến nha.

(hờ tin từ bạn.
 

File đính kèm

Upvote 0
Mình vẫn chưa hiểu ,bạn có thể gộp chung code để mình sử dụng 2 phiếu 1 code được hông?
 
Upvote 0
Là vậy đó bạn;

Mình vẫn chưa hiểu ,bạn có thể gộp chung code để mình sử dụng 2 phiếu 1 code được hông?
Nhấp chuột vào đây để mở rộng...

Thay vì, như hiện nay bạn có
Mã: 
Sub PN()
' . . . . . . '
End Sub

và

Mã: 
Sub PX()
' . . . . . . '
End Sub

Thì giờ ta có đến 3, như vầy

Mã: 
Sub PN()
  GPE , ThSoN, ThSo2
End Sub

Mã: 
Sub PX()
  GPE , ThSoX, ThSo2
End Sub

PHP: 
Sub GPE(ThSo1 As Type, ThSo2 As Type)

'. . . . . . '
'Các dòng lệnh gộp'
'. . . . . . '
End Sub

Nhưng bạn cần khẳng định 2 macro nêu trên trang tính đã đúng chưa cái đã!

Chờ tin từ bạn.
 
Upvote 0
Mình đã thủ nhiều lần rùi và hiện đang áp dụng nó chạy đúng rùi. nhưng mình không biết cách của bạn làm thì có lợi gì hơn cách cũ , chương trình có chạy nhanh hơn không ? bạn có thể giải thích cho mình hiểu với mình mớilàm quen VBA đây thôi.
Chờ tin của bạn . thân
 
Upvote 0
(1) Mình thủ nhiều lần và hiện đang áp dụng nó chạy đúng rùi.

(2) Nhưng mình không biết cách của bạn làm thì có lợi gì hơn cách cũ , chương trình có chạy nhanh hơn không ? bạn có thể giải thích cho mình hiểu với thân
Nhấp chuột vào đây để mở rộng...

(1) Í mình là 2 macro mà mình đã sửa lại & chép chúng lên trang tính trong file kèm theo đó; Bạn coi lại dùm đi.

(2) Rất nhiều trường hợp file sẽ nhẹ đi ít nhiều & nhanh hơn;
2uan trọng là bạn sẽ tiếp cận được 1 fương thức khác hơn & bảo trì sẽ dễ hơn.

(*) /(/ếu bạn cần được chứng minh, thì bạn trích ra & gởi các trang tính liên quan đến fiếu nhập / xuất để bạn mục kỉnh. . . .

Thân.
 
Lần chỉnh sửa cuối:
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
  • Question Question
Em nhờ anh/chị/em/chú/bác giúp em viết code tổng hợp dữ liệu. em tính công thức nó nặng quá. em cám ơn (1 người xem)
Trả lời
10
Đọc
202
pycckuu410
pycckuu410
T
  • Question Question
Xin thầy/cô và anh chị giúp đỡ cách điền thông tin ca kíp trực trong bảng Excel bằng VBA (2 người xem)
Trả lời
0
Đọc
13
tiennd67
T
T
Cần hỏi về bảng Table (1 người xem)
Trả lời
3
Đọc
34
trungdtbidi
T
HeSanbi
Office Tool Plus - Ứng dụng tải, cài đặt, gỡ bỏ, nhập khóa, xóa khóa bản quyền Office nhanh chóng (1 người xem)
    • Thích
Trả lời
4
Đọc
238
ptm0412
ptm0412
C
Lọc chỉ tiêu sheet 1, kết quả tự động ở các sheet còn lại (1 người xem)
Trả lời
2
Đọc
58
Cuong_98
C
Nguyễn Duy Tuân
Lập trình VBA với Google Drive, OneDrive, DropBox cho Upload-Download-Copy-Move...
    • Cảm ơn
Trả lời
3
Đọc
191
Nguyễn Duy Tuân
Nguyễn Duy Tuân
P
  • Question Question
Lấy giá trị duy nhất nhiều cột khác nhau
Trả lời
4
Đọc
123
Duy Tùng 9x
Duy Tùng 9x
4
EXCEL TỰ ĐỘNG MỞ TRÊN WEB
Trả lời
8
Đọc
192
HeSanbi
HeSanbi
N
Công thức tính điền số lượng lũy kế giao hàng theo điều kiện
Trả lời
0
Đọc
34
Ngocminh19
N
A
Xin các bác chỉ giúp cách thống kê danh sách học sinh
Trả lời
6
Đọc
117
Anhnn9
A
Việt Nguyễn 86
Excel hay bị tắt đột ngột và hiện trang trắng khi làm việc
Trả lời
7
Đọc
284
Việt Nguyễn 86
Việt Nguyễn 86
cadafi
Hướng dẫn tạo Macro chuyển số thành chữ trong Open Office 3.1 (Tiếng Việt Unicode)
Trả lời
11
Đọc
25K
minnad123
M
T
hỏi về đếm số ngày doanh thu tăng và giảm
Trả lời
5
Đọc
78
VetMini
V
ongke0711
  • Question Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711) (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
12 13 14
Trả lời
263
Đọc
28K
ongke0711
ongke0711
T
xin công thức tính được số người còn lại theo từng cột
Trả lời
1
Đọc
62
bebo021999
B
D
Hỏi về cách sử dụng data table
Trả lời
2
Đọc
85
ptm0412
ptm0412
hieuxd
  • Question Question
Khi nhập dữ liệu tự động chèn thêm dòng khi số dòng trong bảng mẫu sắp hết (1 người xem)
2
Trả lời
21
Đọc
24K
Bát Giới
Bát Giới
TrungChinhs
  • Question Question
Hỏi cách làm tròn số trong VBA
Trả lời
10
Đọc
7K
VetMini
V
SA_DQ
[Xin hỏi] Cách tính số tiền bình quân của tài khoản trong 1 tháng
Trả lời
15
Đọc
311
ptm0412
ptm0412
dangvandang
Addin mở rộng cho xây dựng
    • Thích
2
Trả lời
34
Đọc
3K
vlba
V
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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom