Giúp mình viết Code chèn thêm các chi phí vào mã đơn giá. (1 người xem)

[bogay]

Mình lay hoay mãi mã không viết nỗi Code. Các bạn giúp mình tý nhé. Mình xin cám ơn nhiều.

 

[Quang_Hải]

Mình lay hoay mãi mã không viết nỗi Code. Các bạn giúp mình tý nhé. Mình xin cám ơn nhiều.

Trên đời này không có gì làm khó được mình vì nếu khó quá thì bỏ cuộc... thế thôi

Sub chen()
Dim dl(), kq(1 To 10000, 1 To 5), noidung, i, j, k
With Sheets("DGCT")
   .[C65536].End(3).Offset(1, -2) = "End"
   dl = .Range(.[a3], .[a65536].End(3)).Resize(, 5).Value
End With
With Sheets("Option")
   noidung = .Range(.[a1], .[a65536].End(3)).Resize(, 2).Value
End With
For i = 2 To UBound(dl)
   If dl(i, 1) <> "" And dl(i - 1, 1) = "" Then
      For j = 1 To UBound(noidung)
         k = k + 1
         kq(k, 3) = noidung(j, 1)
         kq(k, 5) = noidung(j, 2)
      Next
      k = k + 1
      For j = 1 To 5
         kq(k, j) = dl(i, j)
      Next
   Else
      k = k + 1
      For j = 1 To 5
         kq(k, j) = dl(i, j)
      Next
   End If
Next
Sheets("DGCT").[F4].Resize(k - 1, 5) = kq
End Sub

 

[Ba Tê]

Trên đời này không có gì làm khó được mình vì nếu khó quá thì bỏ cuộc... thế thôi

Sub chen()
Dim dl(), kq(1 To 10000, 1 To 5), noidung, i, j, k
With Sheets("DGCT")
   .[C65536].End(3).Offset(1, -2) = "End"
   dl = .Range(.[a3], .[a65536].End(3)).Resize(, 5).Value
End With
With Sheets("Option")
   noidung = .Range(.[a1], .[a65536].End(3)).Resize(, 2).Value
End With
For i = 2 To UBound(dl)
   If dl(i, 1) <> "" And dl(i - 1, 1) = "" Then
      For j = 1 To UBound(noidung)
         k = k + 1
         kq(k, 3) = noidung(j, 1)
         kq(k, 5) = noidung(j, 2)
      Next
      k = k + 1
      For j = 1 To 5
         kq(k, j) = dl(i, j)
      Next
   Else
      k = k + 1
      For j = 1 To 5
         kq(k, j) = dl(i, j)
      Next
   End If
Next
Sheets("DGCT").[F4].Resize(k - 1, 5) = kq
End Sub

Eo hay hổng Eo gì thì cũng có cái này:

k = k + 1
      For j = 1 To 5
         kq(k, j) = dl(i, j)
      Next

Như vầy cũng chạy được mà

Sub chen()
Dim dl(), kq(1 To 10000, 1 To 5), noidung, I, J, K
With Sheets("DGCT")
   .[C65536].End(3).Offset(1, -2) = "End"
   dl = .Range(.[a3], .[a65536].End(3)).Resize(, 5).Value
End With
With Sheets("Option")
   noidung = .Range(.[A1], .[a65536].End(3)).Resize(, 2).Value
End With
For I = 2 To UBound(dl)
   If dl(I, 1) <> "" And dl(I - 1, 1) = "" Then
      For J = 1 To UBound(noidung)
         K = K + 1
         kq(K, 3) = noidung(J, 1)
         kq(K, 5) = noidung(J, 2)
      Next
    End If
      K = K + 1
      For J = 1 To 5
         kq(K, J) = dl(I, J)
      Next
Next
Sheets("DGCT").[F4].Resize(K - 1, 5) = kq
End Sub

Ẹc...

 

[Quang_Hải]

Eo hay hổng Eo gì thì cũng có cái này:

k = k + 1
      For j = 1 To 5
         kq(k, j) = dl(i, j)
      Next

Như vầy cũng chạy được mà

Sub chen()
Dim dl(), kq(1 To 10000, 1 To 5), noidung, I, J, K
With Sheets("DGCT")
   .[C65536].End(3).Offset(1, -2) = "End"
   dl = .Range(.[a3], .[a65536].End(3)).Resize(, 5).Value
End With
With Sheets("Option")
   noidung = .Range(.[A1], .[a65536].End(3)).Resize(, 2).Value
End With
For I = 2 To UBound(dl)
   If dl(I, 1) <> "" And dl(I - 1, 1) = "" Then
      For J = 1 To UBound(noidung)
         K = K + 1
         kq(K, 3) = noidung(J, 1)
         kq(K, 5) = noidung(J, 2)
      Next
    End If
      K = K + 1
      For J = 1 To 5
         kq(K, J) = dl(I, J)
      Next
Next
Sheets("DGCT").[F4].Resize(K - 1, 5) = kq
End Sub

Ẹc...

Ah Mình đem nó ra ngoài thì ngắn được tí, sau lúc đầu em không để ý ta?

 

[bogay]

Trước tiên mình xin chân thành cám ơn các bạn. Giờ mình thêm 2 cột đơn giá, thành tiền. Mình chạy code của các bạn thì cột đơn giá và thành tiền đều biến thành số chết (không còn giữ nguyên liên kết như file gốc). Mình muốn sau khi chèn đuôi chi phí thì cột đơn giá và thành tiền vẫn giữ nguyên liên kết như file gốc. Các bạn hoàn thiện hộ mình nhé (Có file đính kèm). Cám ơn nhiều!

 

[Ba Tê]

Trước tiên mình xin chân thành cám ơn các bạn. Giờ mình thêm 2 cột đơn giá, thành tiền. Mình chạy code của các bạn thì cột đơn giá và thành tiền đều biến thành số chết (không còn giữ nguyên liên kết như file gốc). Mình muốn sau khi chèn đuôi chi phí thì cột đơn giá và thành tiền vẫn giữ nguyên liên kết như file gốc. Các bạn hoàn thiện hộ mình nhé (Có file đính kèm). Cám ơn nhiều!

Kiểu này là phải chèn dòng từ đoạn rồi.
Thử file này xem, giới hạn trong vòng 1000 dòng thôi nghe.

 

[Quang_Hải]

Kiểu này là phải chèn dòng từ đoạn rồi.
Thử file này xem, giới hạn trong vòng 1000 dòng thôi nghe.

Anh Batê ơi sao mình không dùng .Formula hả anh?
Em thấy thế này cũng được nè, không biết có phát sinh gì hay không

To Bogay: Nhớ định dạng lại cột G để hiển thị kết quả cho đúng

Sub chen()
Dim dl(), kq(1 To 10000, 1 To 7), noidung, i, j, k
With Sheets("DGCT")
   .[a:a].Value = .[a:a].Value
   .[c65536].End(3).Offset(1, -2) = "End"
   dl = .Range(.[a3], .[a65536].End(3)).Resize(, 7).Formula
End With
With Sheets("Option")
   noidung = .Range(.[a1], .[a65536].End(3)).Resize(, 2).Value
End With
For i = 2 To UBound(dl)
   If dl(i, 1) <> "" And dl(i - 1, 1) = "" Then
      For j = 1 To UBound(noidung)
         k = k + 1
         kq(k, 3) = noidung(j, 1)
         kq(k, 7) = noidung(j, 2)
      Next
   End If
   k = k + 1
   For j = 1 To 7
      kq(k, j) = dl(i, j)
   Next
Next
With Sheets("DGCT")
   .[A4].Resize(k - 1, 7) = kq
   .Range(.[a3], .[c65536].End(3).Offset(, 4)).Borders.Value = 1
End With
End Sub