Giúp mình INSERT và COPY với

[bhquachtuong]

mình có bài toán như vầy.
[TABLE="class: grid, width: 500"]
[TR]
[TD]Tên[/TD]
[TD]Số lượng[/TD]
[/TR]
[TR]
[TD]Dell[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]Sony[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]HP[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Asus[/TD]
[TD]2[/TD]
[/TR]
[/TABLE]

Tương ứng với mỗi tên ta có số lượng. Em muốn insert và copy tên đó xuống tương ứng với cột số lượng

Kết quả sẽ như thế này
[TABLE="class: grid, width: 500"]
[TR]
[TD]Tên[/TD]
[TD]số lượng[/TD]
[/TR]
[TR]
[TD]Dell[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]Dell[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Dell[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]sony[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]sony[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]sony[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]sony[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]HP[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Asus[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]Asus[/TD]
[TD][/TD]
[/TR]
[/TABLE]

Các Bạn giúp mình với

 

[Elris Trần]

k hiểu câu hỏi.làm sao giúp đây ta?

 

[bhquachtuong]

Tức là dell có số lượng là 3. thi làm sao chèn phía sau no thêm 2 dòng nữa để được 3 dong mang tên dell. giống như kết quả minh cho ở trên đó bạn

 

[Hoàng Trọng Nghĩa]

Tức là dell có số lượng là 3. thi làm sao chèn phía sau no thêm 2 dòng nữa để được 3 dong mang tên dell. giống như kết quả minh cho ở trên đó bạn

Bước 1: Chọn hàng cần copy sau đó bấm Copy. Sau đó chọn 2 hàng (hay bao nhiêu bạn muốn, ở đây chọn 3 hàng) liền kề rồi click chuột phải để chọn Insert Copy Cells...

Bước 2: Một hộp thoại hiện ra để cho bạn chọn lựa cách mà hàng sau khi insert sẽ "dịch chuyển" cells về phía nào, bạn nên chọn Shift cells down.

 

[bhquachtuong]

Bước 1: Chọn hàng cần copy sau đó bấm Copy. Sau đó chọn 2 hàng (hay bao nhiêu bạn muốn, ở đây chọn 3 hàng) liền kề rồi click chuột phải để chọn Insert Copy Cells...

Bước 2: Một hộp thoại hiện ra để cho bạn chọn lựa cách mà hàng sau khi insert sẽ "dịch chuyển" cells về phía nào, bạn nên chọn Shift cells down.

Ý hỏi là còn cách nào khác cách thủ công đó không. chứ cách đó thì mình biết. Vấn đề là có nhiều dòng chắc làm thủ công kiểu này mệt xỉu

 

[Hoàng Trọng Nghĩa]

Ý hỏi là còn cách nào khác cách thủ công đó không. chứ cách đó thì mình biết. Vấn đề là có nhiều dòng chắc làm thủ công kiểu này mệt xỉu

Đành phải chịu thủ công thôi bạn, sao mà làm cách khác được? Kể cả dùng lập trình VBA, làm sao xác định được hàng/ cột nào sau khi Insert nó sẽ dịch chuyển là bao nhiêu để mà xác định được vị trí, cho dù có cho nó bắt đầu từ dưới lên trên cũng rất khó xác định sau khi có một nhóm hàng cột được chọn để copy.

Chỉ có thủ công làm cho mình copy và insert một cách chính xác mà thôi.

 

[bhquachtuong]

Đành phải chịu thủ công thôi bạn, sao mà làm cách khác được? Kể cả dùng lập trình VBA, làm sao xác định được hàng/ cột nào sau khi Insert nó sẽ dịch chuyển là bao nhiêu để mà xác định được vị trí, cho dù có cho nó bắt đầu từ dưới lên trên cũng rất khó xác định sau khi có một nhóm hàng cột được chọn để copy.

Chỉ có thủ công làm cho mình copy và insert một cách chính xác mà thôi.

Vậy đành thủ công vậy. Cám ơn bạn nhiều

 

[Hau151978]

Bạn dùng thử code sau, do dữ liệu không nhiều lắm nên đọc ghi trực tiếp cho nhanh

Sub a()
Dim n As Long, i As Long, j As Long, k As Long
n = Range("a65536").End(xlUp).Row
k = n + 1
For i = 2 To n
For j = 1 To Range("b" & i)
Range("a" & (k + j)) = Range("a" & i)
If j = 1 Then Range("b" & (k + 1)) = Range("b" & i)
Next
k = k + Range("b" & i)
Next
End Sub

 

[Hoàng Trọng Nghĩa]

Bạn dùng thử code sau, do dữ liệu không nhiều lắm nên đọc ghi trực tiếp cho nhanh

Sub a()
Dim n As Long, i As Long, j As Long, k As Long
n = Range("a65536").End(xlUp).Row
k = n + 1
For i = 2 To n
For j = 1 To Range("b" & i)
Range("a" & (k + j)) = Range("a" & i)
If j = 1 Then Range("b" & (k + 1)) = Range("b" & i)
Next
k = k + Range("b" & i)
Next
End Sub

Gì vậy bạn? Đâu phải hàng nào cũng giống hàng nào đâu, lúc họ Insert 2 hàng, lúc 3 hàng, cũng có hàng không Insert, đưa code này vô làm gì trời!? Nếu chỉ 1 quy luật như thế thì nói gì nữa!

 

[Hau151978]

Gì vậy bạn? Đâu phải hàng nào cũng giống hàng nào đâu, lúc họ Insert 2 hàng, lúc 3 hàng, cũng có hàng không Insert, đưa code này vô làm gì trời!? Nếu chỉ 1 quy luật như thế thì nói gì nữa!

Bạn xem lại bài 3, tác giả có ghi ví dụ Dell 3 thì ở dưới sẽ thành 3 dòng Dell.

 

[Hoàng Trọng Nghĩa]

Bạn xem lại bài 3, tác giả có ghi ví dụ Dell 3 thì ở dưới sẽ thành 3 dòng Dell.

Do tôi đọc không kỹ yêu cầu nên mới trả lời như thế, tuy nhiên, code của bạn vẫn chưa đáp ứng được yêu cầu của bài viết vì phải insert ngay trong cái bảng đó chứ không phải dịch chuyển qua chỗ khác, vì là copy nên định dạng cũng phải giống như định dạng của ô gốc. Tôi làm như sau:

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    
    Dim r As Long, n As Long
    Dim FirstRow As Long, EndRow As Long
    
    FirstRow = 2
    EndRow = Range("A" & FirstRow).End(xlDown).Row
    
    For r = EndRow To FirstRow Step -1
        n = Range("B" & r).Value
        If n > 1 Then
            Range("A" & r & ":B" & r).Copy
            n = n + r - 1
            Range("A" & r + 1 & ":B" & n).Insert Shift:=xlDown
            Range("B" & r + 1 & ":B" & n).ClearContents
        End If
    Next
    
    Application.ScreenUpdating = True
End Sub

 

[nhanvvGPE]

mình có bài toán như vầy.
[TABLE="class: grid, width: 500"]
[TR]
[TD]Tên[/TD]
[TD]Số lượng[/TD]
[/TR]
[TR]
[TD]Dell[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]Sony[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]HP[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Asus[/TD]
[TD]2[/TD]
[/TR]
[/TABLE]

Tương ứng với mỗi tên ta có số lượng. Em muốn insert và copy tên đó xuống tương ứng với cột số lượng

Kết quả sẽ như thế này
[TABLE="class: grid, width: 500"]
[TR]
[TD]Tên[/TD]
[TD]số lượng[/TD]
[/TR]
[TR]
[TD]Dell[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]Dell[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Dell[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]sony[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]sony[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]sony[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]sony[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]HP[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Asus[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]Asus[/TD]
[TD][/TD]
[/TR]
[/TABLE]

Các Bạn giúp mình với

Chào bạn!

Bạn dùng thử code trong file đính kèm nha!

Sub loopThruSourceData()
Sheets("Sheet1").Range("D2:E10000").ClearContents
Dim cll As Range
Dim i As Integer
Dim DesRangeCount As Integer
For Each cll In Sheets("Sheet1").Range("SourceDataRange")
For i = 1 To cll.Offset(0, 1)
On Error Resume Next
DesRangeCount = WorksheetFunction.CountA(Sheets("Sheet1").Range("DesDataRange")) + 2
If Err.Number <> 0 Then DesRangeCount = 2
If i = 1 Then
Sheets("Sheet1").Cells(DesRangeCount, 4) = cll
Sheets("Sheet1").Cells(DesRangeCount, 5) = cll.Offset(0, 1)
Else
Sheets("Sheet1").Cells(DesRangeCount, 4) = cll
End If
Next
Next
End Sub

Thân!
Nhanvv

 

[nhanvvGPE]

Do tôi đọc không kỹ yêu cầu nên mới trả lời như thế, tuy nhiên, code của bạn vẫn chưa đáp ứng được yêu cầu của bài viết vì phải insert ngay trong cái bảng đó chứ không phải dịch chuyển qua chỗ khác, vì là copy nên định dạng cũng phải giống như định dạng của ô gốc. Tôi làm như sau:

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    
    Dim r As Long, n As Long
    Dim FirstRow As Long, EndRow As Long
    
    FirstRow = 2
    EndRow = Range("A" & FirstRow).End(xlDown).Row
    
    For r = EndRow To FirstRow Step -1
        n = Range("B" & r).Value
        If n > 1 Then
            Range("A" & r & ":B" & r).Copy
            n = n + r - 1
            Range("A" & r + 1 & ":B" & n).Insert Shift:=xlDown
            Range("B" & r + 1 & ":B" & n).ClearContents
        End If
    Next
    
    Application.ScreenUpdating = True
End Sub

Hi Bạn,

Mình bấm nhầm vài lần là thấy dữ liệu đột biến liền hihi!

Thân

 

[Hoàng Trọng Nghĩa]

Hi Bạn,

Mình bấm nhầm vài lần là thấy dữ liệu đột biến liền hihi!

Thân

Tôi có một số lưu ý cho file mới này như sau:

1) CHÚ Ý: Trước khi thực thi, các mục TÊN phải có số tại cột SỐ LƯỢNG nếu không chúng sẽ bị xóa mất mục đó!

2) Nếu đã bấm nút rồi mà bấm lại thì kết quả vẫn không thay đổi (mặc dù code vẫn thực thi và trả lại kết quả mới)

3) Nếu muốn thêm hay bớt, thì sửa lại các số đang hiện hành tại cột B. Giả sử bạn đã Insert thành 8 dòng rỗng rồi, (ô số lượng hiện tại là 9), nếu bạn muốn bớt lại số ô copy chỉ còn là 5 thì bạn sửa lại 9 thành 6, hoặc ngược lại, nếu bạn muốn thêm 3 ô nữa thì sửa 9 thành 12 sau đó bấm nút InsertRows.

Sau đây là code của file mới:

Private Sub CommandButton1_Click()
    ''Ngan chan viec cap nhat man hinh, su kien, tinh toan:
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    ''-------------------------------------------
    
    Dim r As Long, n As Long
    Dim FirstRow As Long, EndRow As Long
    
    FirstRow = 2
    EndRow = Range("A" & FirstRow).End(xlDown).Row
    
    ''Xoa cac dong trong:
    For r = EndRow To FirstRow Step -1
        If Range("B" & r) = "" Then
            Range("A" & r & ":B" & r).Delete 2
        End If
    Next


    ''Cap nhat lai hang cuoi:
    EndRow = Range("A" & FirstRow).End(xlDown).Row
    
    ''Insert them hang theo gia tri o cot B:
    For r = EndRow To FirstRow Step -1
        n = Val(Range("B" & r))
        If n > 1 Then
            n = n + r - 1
            Range("A" & r & ":B" & r).Copy
            Range("A" & r + 1 & ":B" & n).Insert 2
            Range("B" & r + 1 & ":B" & n).ClearContents
        End If
    Next
    
    ''-------------------------------------------
    ''Tra lai viec cap nhat man hinh, su kien, tinh toan:
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub