thay công thức bằng code (1 người xem)

[katylove83]

em có file này em đã viết công thức rồi, nhưng ko biết code lập trình thì viết thế nào

các bác cho em xin cái code nhé

cám ơn

 

[nmhung49]

em có file này em đã viết công thức rồi, nhưng ko biết code lập trình thì viết thế nào

các bác cho em xin cái code nhé

cám ơn

Copy code này vào module chạy
[GPECODE=vb]
Sub GPE()
Dim i As Long, k As Long, j As Long
Dim sArr, KQ
sArr = Sheets("data").UsedRange.Offset(1).Value
ReDim KQ(1 To UBound(sArr) * 2, 1 To UBound(sArr, 2) + 1)
j = 0
For i = 1 To UBound(sArr)
If sArr(i, 1) <> "" Then
j = k + 1: k = j + 1
KQ(j, 1) = sArr(i, 1): KQ(k, 1) = sArr(i, 1)
KQ(j, 2) = sArr(i, 2): KQ(k, 2) = sArr(i, 2)
KQ(j, 3) = sArr(i, 3): KQ(k, 3) = sArr(i, 3)
KQ(j, 4) = "a"
KQ(j, 5) = sArr(i, 4): KQ(k, 5) = sArr(i, 4)
KQ(j, 6) = sArr(i, 6): KQ(k, 7) = sArr(i, 6)
End If
Next
Sheets("nkc").Range("B15").Resize(k, 7).Value = KQ
End Sub


[/GPECODE]

 

[comet_1701]

em có file này em đã viết công thức rồi, nhưng ko biết code lập trình thì viết thế nào

các bác cho em xin cái code nhé

cám ơn

Mình chỉ hơi băn khoăn là ở sheet nkc, tại sao tài khoản nợ có đều giống nhau vậy
Ý đồ của tác giả hay bị nhầm lẫn

 

[katylove83]

Copy code này vào module chạy
[GPECODE=vb]
Sub GPE()
Dim i As Long, k As Long, j As Long
Dim sArr, KQ
sArr = Sheets("data").UsedRange.Offset(1).Value
ReDim KQ(1 To UBound(sArr) * 2, 1 To UBound(sArr, 2) + 1)
j = 0
For i = 1 To UBound(sArr)
If sArr(i, 1) <> "" Then
j = k + 1: k = j + 1
KQ(j, 1) = sArr(i, 1): KQ(k, 1) = sArr(i, 1)
KQ(j, 2) = sArr(i, 2): KQ(k, 2) = sArr(i, 2)
KQ(j, 3) = sArr(i, 3): KQ(k, 3) = sArr(i, 3)
KQ(j, 4) = "a"
KQ(j, 5) = sArr(i, 4): KQ(k, 5) = sArr(i, 4)
KQ(j, 6) = sArr(i, 6): KQ(k, 7) = sArr(i, 6)
End If
Next
Sheets("nkc").Range("B15").Resize(k, 7).Value = KQ
End Sub


[/GPECODE]

code sai , vơi yêu cầu rui bác ơi hehehe

 

[nmhung49]

code sai , vơi yêu cầu rui bác ơi hehehe

Không hiểu số hiệu??? thay chỗ này thành

KQ(j, 5) = sArr(i, 5): KQ(k, 5) = sArr(i, 5)

Mình chỉ hơi băn khoăn là ở sheet nkc, tại sao tài khoản nợ có đều giống nhau vậy
Ý đồ của tác giả hay bị nhầm lẫn

Không hiểu nên viết bị sai ai biết tác giả muốn gì

 

[Quang_Hải]

em có file này em đã viết công thức rồi, nhưng ko biết code lập trình thì viết thế nào

các bác cho em xin cái code nhé

cám ơn

Tham khảo thêm code này, bổ sung thêm cái vụ chèn cho đủ dòng và xoá bớt khi thừa dòng
*** Sau khi chạy code lần đầu, xoá hết các dòng trống thừa phía dưới, chỉ để lại 2 dòng trống từ dòng tổng và dòng dữ liệu cuối là được

Sub QuangHai()
Dim i As Long, k As Long, j As Byte
Dim sArr(), KQ(1 To 10000, 1 To 7)
With Sheets("data")
   sArr = .Range(.[A5], .[F65536].End(3)).Value
End With
For i = 1 To UBound(sArr)
   For j = 1 To 2
      k = k + 1
      KQ(k, 1) = sArr(i, 2)
      KQ(k, 2) = sArr(i, 1)
      KQ(k, 3) = sArr(i, 3)
      KQ(k, 4) = "a"
      KQ(k, 5) = sArr(i, 5)
   Next
   KQ(k - 1, 6) = sArr(i, 6)
   KQ(k, 7) = sArr(i, 6)
Next
With Sheets("nkc")
   .Range(.[B15], .[B15].End(4)).EntireRow.Delete
   .[B16].Resize(k).EntireRow.Insert
   .[B15].Resize(k, 7).Value = KQ
End With
End Sub

 

[katylove83]

Tham khảo thêm code này, bổ sung thêm cái vụ chèn cho đủ dòng và xoá bớt khi thừa dòng
*** Sau khi chạy code lần đầu, xoá hết các dòng trống thừa phía dưới, chỉ để lại 2 dòng trống từ dòng tổng và dòng dữ liệu cuối là được

Sub QuangHai()
Dim i As Long, k As Long, j As Byte
Dim sArr(), KQ(1 To 10000, 1 To 7)
With Sheets("data")
   sArr = .Range(.[A5], .[F65536].End(3)).Value
End With
For i = 1 To UBound(sArr)
   For j = 1 To 2
      k = k + 1
      KQ(k, 1) = sArr(i, 2)
      KQ(k, 2) = sArr(i, 1)
      KQ(k, 3) = sArr(i, 3)
      KQ(k, 4) = "a"
      KQ(k, 5) = sArr(i, 5)
   Next
   KQ(k - 1, 6) = sArr(i, 6)
   KQ(k, 7) = sArr(i, 6)
Next
With Sheets("nkc")
   .Range(.[B15], .[B15].End(4)).EntireRow.Delete
   .[B16].Resize(k).EntireRow.Insert
   .[B15].Resize(k, 7).Value = KQ
End With
End Sub

code của anh vẫn còn thiếu chổ sum chua hoạt động đúng, vì nêu thay đổi dòng thì sum cũng sẽ tự động thây đổi theo mới đúng

 

[Hoàng Trọng Nghĩa]

code của anh vẫn còn thiếu chổ sum chua hoạt động đúng, vì nêu thay đổi dòng thì sum cũng sẽ tự động thây đổi theo mới đúng

Đó là SUB chứ có phải FUNCTION đâu mà thay đổi theo bạn? Muốn thay đổi theo bạn phải kích hoạt sub đó chạy thì mới thực thi lệnh được chứ!

 

[katylove83]

Đó là SUB chứ có phải FUNCTION đâu mà thay đổi theo bạn? Muốn thay đổi theo bạn phải kích hoạt sub đó chạy thì mới thực thi lệnh được chứ!

sory các bác em bị nhầm công thức 1 tí e port file lên lại nhé thay đổi chổ cột F

sory

 

[Quang_Hải]

Sub QuangHai()
Dim i As Long, k As Long, j As Byte
Dim sArr(), KQ(1 To 10000, 1 To 7)
With Sheets("data")
   sArr = .Range(.[A5], .[F65536].End(3)).Value
End With
For i = 1 To UBound(sArr)
   For j = 1 To 2
      k = k + 1
      KQ(k, 1) = sArr(i, 2)
      KQ(k, 2) = sArr(i, 1)
      KQ(k, 3) = sArr(i, 3)
      KQ(k, 4) = "a"
   Next
   KQ(k - 1, 5) = sArr(i, 4)
   KQ(k, 5) = sArr(i, 5)
   KQ(k - 1, 6) = sArr(i, 6)
   KQ(k, 7) = sArr(i, 6)
Next
With Sheets("nkc")
   .Range(.[B15], .[B15].End(4)).EntireRow.Delete
   .[B16].Resize(k).EntireRow.Insert
   .[B15].Resize(k, 7).Value = KQ
End With
End Sub

 

[katylove83]

Có những điều suy nghĩ nhưng không thể nói ra. Hay là bạn copy code này cho vào sheet nkc nhé

Private Sub Worksheet_Activate()
QuangHai
End Sub

anh hải sửa lại giúp đoạn code theo file e mớ post nhé đoạn code của anh em them vào sheet nkc cung ko thay đổi gì kết quả cả
anh xem lại giúp nhé

 

[Quang_Hải]

anh hải sửa lại giúp đoạn code theo file e mớ post nhé đoạn code của anh em them vào sheet nkc cung ko thay đổi gì kết quả cả
anh xem lại giúp nhé

Xem lại code bài số 10 đã sửa lại theo file mới

 

[nmhung49]

sory các bác em bị nhầm công thức 1 tí e port file lên lại nhé thay đổi chổ cột F

sory

Thật sự code bài 2 đã giải quyết vấn đề rồi bạn không xem kỹ nên. Post bài số liệu phải chuẩn vì không ai ở không cứ sửa đi sửa lại giúp bạn
@Quanghai: Code dùng thêm vòng lặp trong em nghĩ nó có thể chậm hơn dùsau mình cũng đã tốn 2 biến rồi. Nếu viết gọn thì em thấy cũng không gọn được bao nhiêu

 

[katylove83]

Thật sự code bài 2 đã giải quyết vấn đề rồi bạn không xem kỹ nên. Post bài số liệu phải chuẩn vì không ai ở không cứ sửa đi sửa lại giúp bạn
@Quanghai: Code dùng thêm vòng lặp trong em nghĩ nó có thể chậm hơn dùsau mình cũng đã tốn 2 biến rồi. Nếu viết gọn thì em thấy cũng không gọn được bao nhiêu

cám ơn bạn nhiều minh giai quyêt được vấn đề rồi