Nhân bản cột với số thứ tự tại Cột F giảm dần

[pham ha 94]

Mình có up file lên để dễ nhìn hơn
File đã xử lý được phần dữ liệu nhân bản thêm hàng mới theo Số tại cột E, nhưng cột F muốn dữ liệu giảm dần mà loay hoay mãi không được.
Nhờ các bác giúp mình chỉnh sửa đoạn code để chạy được với. Cảm ơn các bác đã xem và giúp đỡ

Dữ liệu gốc

Dữ liệu mong muốn

Cot A

Cot B

Cot C

Cot D

Cot E Số cột nhân bản

Cột F Số giảm dần

Cot A

Cot B

Cot C

Cot D

Cot E Số cột nhân bản

Cột F Số giảm dần

Giải thích: mỗi cột sẽ nhân bản thêm N dòng (N bằng dữ liệu tại cột E) Mong muốn: Cột F sẽ giảm xuống theo thứ tự, ví dụ gốc F2 là 14 và E2 là 3 thì chuyển sang bảng bên sẽ giảm dần và nhỏ hơn giá trị tại F2 là 1 đơn vị

A2

B2

C2

D2

3​

14​

A2

B2

C2

D2

3​

11​

A3

B3

C3

D3

4​

34​

A2

B2

C2

D2

3​

12​

A4

B4

C4

D4

3​

53​

A2

B2

C2

D2

3​

13​

A5

B5

C5

D5

1​

70​

A3

B3

C3

D3

4​

30​

A6

B6

C6

D6

0​

90​

A3

B3

C3

D3

4​

31​

A3

B3

C3

D3

4​

32​

A3

B3

C3

D3

4​

33​

A4

B4

C4

D4

3​

50​

A4

B4

C4

D4

3​

51​

A4

B4

C4

D4

3​

52​

A5

B5

C5

D5

1​

69​

A6

B6

C6

D6

0​

90​

 

[snow25]

Mình có up file lên để dễ nhìn hơn
File đã xử lý được phần dữ liệu nhân bản thêm hàng mới theo Số tại cột E, nhưng cột F muốn dữ liệu giảm dần mà loay hoay mãi không được.
Nhờ các bác giúp mình chỉnh sửa đoạn code để chạy được với. Cảm ơn các bác đã xem và giúp đỡ

Dữ liệu gốc

Dữ liệu mong muốn

Cot A

Cot B

Cot C

Cot D

Cot E Số cột nhân bản

Cột F Số giảm dần

Cot A

Cot B

Cot C

Cot D

Cot E Số cột nhân bản

Cột F Số giảm dần

Giải thích: mỗi cột sẽ nhân bản thêm N dòng (N bằng dữ liệu tại cột E) Mong muốn: Cột F sẽ giảm xuống theo thứ tự, ví dụ gốc F2 là 14 và E2 là 3 thì chuyển sang bảng bên sẽ giảm dần và nhỏ hơn giá trị tại F2 là 1 đơn vị

A2

B2

C2

D2

3​

14​

A2

B2

C2

D2

3​

11​

A3

B3

C3

D3

4​

34​

A2

B2

C2

D2

3​

12​

A4

B4

C4

D4

3​

53​

A2

B2

C2

D2

3​

13​

A5

B5

C5

D5

1​

70​

A3

B3

C3

D3

4​

30​

A6

B6

C6

D6

0​

90​

A3

B3

C3

D3

4​

31​

A3

B3

C3

D3

4​

32​

A3

B3

C3

D3

4​

33​

A4

B4

C4

D4

3​

50​

A4

B4

C4

D4

3​

51​

A4

B4

C4

D4

3​

52​

A5

B5

C5

D5

1​

69​

A6

B6

C6

D6

0​

90​

Sửa 1 cút code của bạn.

Sub test()
Dim arr(), res(), srRes&, n&, k&, j&, L&, R As Long
      arr = Sheet1.Range("A3:F7").Value
      For n = 1 To UBound(arr)
                srRes = srRes + arr(n, 5)
      Next n
      ReDim res(1 To srRes, 1 To 6)
            For n = 1 To UBound(arr)
                    L = arr(n, 5)
                    R = arr(n, 6) - arr(n, 5)
                    For j = 1 To L
                      k = k + 1
                        res(k, 1) = arr(n, 1)
                        res(k, 2) = arr(n, 2)
                        res(k, 3) = arr(n, 3)
                        res(k, 4) = arr(n, 4)
                        res(k, 5) = arr(n, 5)
                        res(k, 6) = R
                        R = R + 1
                     Next j
                Next n
      Sheet1.Range("H3").Resize(k, 6).Value = res
End Sub

 

[Maika8008]

Mọi người cho tôi hỏi: Chừ tại chỗ này:
res(k, 1) = arr(n, 1)

mà chuyển thành:
For c = 1 to 5
...
next c

thì kiểu nào chạy nhanh hơn hay là cả 2 như nhau nhỉ? (tất nhiên không bàn về chuyện gọn code vì for ... next gọn hơn rồi)

 

[bebo021999]

Góp vui:

Sub nhanban()
Dim lr&, i&, j&, t&, k&, first&, rng, res(1 To 10000, 1 To 6)
lr = Cells(Rows.Count, "A").End(xlUp).Row
rng = Range("A3:F" & lr).Value
For i = 1 To UBound(rng)
    first = rng(i, 6) - rng(i, 5)
    Select Case rng(i, 5)
        Case Is < 2
            k = k + 1
            For j = 1 To 6
                res(k, j) = rng(i, j)
            Next
            If rng(i, 5) = 1 Then res(k, 6) = rng(i, 6) - 1
        Case Else
            For t = 1 To rng(i, 5)
                k = k + 1
                For j = 1 To 5
                    res(k, j) = rng(i, j)
                Next
                res(k, 6) = first
                first = first + 1
            Next
    End Select
Next
Range("A3").Resize(k, 6).Value = res
End Sub

Bài đã được tự động gộp: 24/4/23

Mọi người cho tôi hỏi: Chừ tại chỗ này:
res(k, 1) = arr(n, 1)

mà chuyển thành:
For c = 1 to 5
...
next c

thì kiểu nào chạy nhanh hơn hay là cả 2 như nhau nhỉ? (tất nhiên không bàn về chuyện gọn code vì for ... next gọn hơn rồi)

Dạ, nhân bản số dòng lên vài chục ngàn dòng, xong rồi chạy thử 2 cái code mới biết được chính xác ạ,

 

[Maika8008]

Dạ, nhân bản số dòng lên vài chục ngàn dòng, xong rồi chạy thử 2 cái code mới biết được chính xác ạ,

Vài chục ngàn dòng thì nhìn code
res(k, 1) = arr(n, 1)
...
res(k, xxxxx) = arr(n, xxxxx)
chịu sao thấu?

Phải có chuyên gia GPE suy luận chứ.

 

[pham ha 94]

Sửa 1 cút code của bạn.

Sub test()
Dim arr(), res(), srRes&, n&, k&, j&, L&, R As Long
      arr = Sheet1.Range("A3:F7").Value
      For n = 1 To UBound(arr)
                srRes = srRes + arr(n, 5)
      Next n
      ReDim res(1 To srRes, 1 To 6)
            For n = 1 To UBound(arr)
                    L = arr(n, 5)
                    R = arr(n, 6) - arr(n, 5)
                    For j = 1 To L
                      k = k + 1
                        res(k, 1) = arr(n, 1)
                        res(k, 2) = arr(n, 2)
                        res(k, 3) = arr(n, 3)
                        res(k, 4) = arr(n, 4)
                        res(k, 5) = arr(n, 5)
                        res(k, 6) = R
                        R = R + 1
                     Next j
                Next n
      Sheet1.Range("H3").Resize(k, 6).Value = res
End Sub

Cảm ơn bác nhiều, code chạy ngon rồi, thế mà tối qua nghĩ mãi k ra.

Mọi người cho tôi hỏi: Chừ tại chỗ này:
res(k, 1) = arr(n, 1)

mà chuyển thành:
For c = 1 to 5
...
next c

thì kiểu nào chạy nhanh hơn hay là cả 2 như nhau nhỉ? (tất nhiên không bàn về chuyện gọn code vì for ... next gọn hơn rồi)

nó vướng cột 4 là mình thêm dấu ' vì cột 4 là số có đầu số là 0, nhưng mình đang làm gọn dữ liệu cho dễ nhìn. Với có 6 cột k dài, nếu k thì dùng for next cho gọn code

Góp vui:

Sub nhanban()
Dim lr&, i&, j&, t&, k&, first&, rng, res(1 To 10000, 1 To 6)
lr = Cells(Rows.Count, "A").End(xlUp).Row
rng = Range("A3:F" & lr).Value
For i = 1 To UBound(rng)
    first = rng(i, 6) - rng(i, 5)
    Select Case rng(i, 5)
        Case Is < 2
            k = k + 1
            For j = 1 To 6
                res(k, j) = rng(i, j)
            Next
            If rng(i, 5) = 1 Then res(k, 6) = rng(i, 6) - 1
        Case Else
            For t = 1 To rng(i, 5)
                k = k + 1
                For j = 1 To 5
                    res(k, j) = rng(i, j)
                Next
                res(k, 6) = first
                first = first + 1
            Next
    End Select
Next
Range("A3").Resize(k, 6).Value = res
End Sub

Bài đã được tự động gộp: 24/4/23

Dạ, nhân bản số dòng lên vài chục ngàn dòng, xong rồi chạy thử 2 cái code mới biết được chính xác ạ,

cảm ơn bác rất nhiều

 

[snow25]

Mọi người cho tôi hỏi: Chừ tại chỗ này:
res(k, 1) = arr(n, 1)

mà chuyển thành:
For c = 1 to 5
...
next c

thì kiểu nào chạy nhanh hơn hay là cả 2 như nhau nhỉ? (tất nhiên không bàn về chuyện gọn code vì for ... next gọn hơn rồi)

Tôi nghĩ nó vẫn thế vì khi chạy thử bằng F8 thì nó vẫn thực hiện code như vậy.Chắc hơn là thêm đoạn thời gian chạy vào vòng lặp và ra vòng lặp thôi.