Giúp em viết Code paste special qua phần mềm khác.

[ninhhai]

Em có một phần mềm cho phép paste dữ liệu từ Clipboard, em muốn copy dữ liệu từ Excel và paste vào cửa sổ nhập liệu của phần mềm đó. Nhưng dữ liệu trong file Excel sắp xếp theo hàng ngang, không liền kề, có chứa ô rỗng và công thức trong hàng. Còn cửa sổ nhập liệu của phần mềm kia lại sắp xếp theo chiều dọc. Mong các anh chị giúp em viết 1 code VBA để làm sao:
- Copy dữ liệu, nhưng loại bỏ cột có chứa ô rỗng.
- Paste thành chiều dọc và chỉ lấy giá trị của công thức.
Nếu có thể copy trực tiếp vào Clipboard là tốt nhất, nếu không thì qua một vùng trung gian cũng được.

Em xin cảm ơn.

 

[khoavu87]

Bạn thử dùng code này xem sao?

Sub Macro1()
    Range("b2:e4").SpecialCells(2).Copy
    Range("h5").PasteSpecial Paste:=xlPasteValues, Transpose:=True
End Sub

 

[ninhhai]

Em thử rồi nhưng không được, nó báo lỗi 1004

 

[MinhCong]

Dùng cách thủ công vậy

Sub Locdulieu()
 Dim enC As Long, iC As Long, jR As Long
  enC = Range("B2").End(xlToRight).Column
   jR = 5: Range("H5").CurrentRegion.Clear
     For iC = 2 To enC
        If Cells(4, iC) <> "" Then
            Range("H" & jR) = Cells(2, iC)
            Range("H" & jR).Offset(, 1) = Cells(4, iC)
            jR = jR + 1
        End If
     Next
   Range("B2,B4").Copy
  Range("H5").CurrentRegion.PasteSpecial Paste:=xlPasteFormats, Transpose:=True
 Application.CutCopyMode = False
End Sub

 

[Quang_Hải]

Mình cũng làm trong ngành may nên có thể hiểu bạn đang cần gì. Mình góp ý là bạn nên lập 1 bảng theo hàng dọc, dùng công thức dò tìm ( HLOOKUP) để có dữ liệu theo hàng dọc, sau đó copy và dán vào phân mêm.

 

[ninhhai]

Dùng cách thủ công vậy

Hi hi, cách " thủ công" của anh lợi hại thật, chạy băng băng kể cả khi thêm cột vào nguồn. Anh cho em hỏi thêm: dòng nào trong code quy định copy row 4 vậy? em nghĩ mãi không ra. ( thông cảm bởi vì em chỉ mới bắt đầu tìm hiểu về VBA thôi) . Hay là anh sửa giùm vào file của em với. Em muốn khi Click vào nút " Copy to GB" thì có thể copy dữ liệu của ("E15:N15") và hàng tương ứng với nút vào clipboard.

Mình cũng làm trong ngành may nên có thể hiểu bạn đang cần gì. Mình góp ý là bạn nên lập 1 bảng theo hàng dọc, dùng công thức dò tìm ( HLOOKUP) để có dữ liệu theo hàng dọc, sau đó copy và dán vào phân mêm.

Mình muốn có một file tốt nhất có thể.

TB: Cuối cùng em cũng đã hiểu được code của anh MinhCong, cảm ơn anh rất nhiều.

 

[ninhhai]

Sau khi được anh MinhCong giúp đỡ, em đã có được một file Excel tương đối ưng ý. Tuy nhiên em còn một vấn đề với file của mình, đó là tuy đó là file .xls nhưng lại không thể mở bằng Excel 2003 được vì lỗi lồng quá nhiều hàm if. Nhờ các anh chị tư vấn thêm cho em.
Em xin cảm ơn.

 

[MinhCong]

Sau khi được anh MinhCong giúp đỡ, em đã có được một file Excel tương đối ưng ý. Tuy nhiên em còn một vấn đề với file của mình, đó là tuy đó là file .xls nhưng lại không thể mở bằng Excel 2003 được vì lỗi lồng quá nhiều hàm if. Nhờ các anh chị tư vấn thêm cho em.
Em xin cảm ơn.

File ở bài #6 phía trên Tôi mở bằng excel 2003 được mà. Lồng nhiều hàm if có phải ở cột O không? Nếu thế bạn dùng công thức mảng cho nó gọn. Tại ô O18 Bạn nhập công thức sau:

=MIN(IF(ISERROR(E17:N17/E18:N18),10000,E17:N17/E18:N18))

Kết thúc bằng tổ hợp phím Ctrl+Shift+Enter

 

[ninhhai]

Hay quá, cám ơn anh rất nhiều. Càng tìm hiểu mới càng thấy kiến thức của mình còn quá ít.
Thực ra file này còn một sheet nữa, nhưng sheet đó có công thức em lồng quá nhiều hàm If nên phải cắt đi vì không thể save thành .xls được.
Anh xem giúp em có cách nào rút gọn lại được không.

=IF(B9<=SUM(AE$9:AE$27),IF(AND(B9=AE$9,MOD(AD$9,F$5)>0),MOD(AD$9,F$5),IF(AND(B9=AE$9+AE$11,MOD(AD$11,F$5)>0),MOD(AD$11,F$5),IF(AND(B9=AE$9+AE$11+AE$13,MOD(AD$13,F$5)>0),MOD(AD$13,F$5),IF(AND(B9=SUM(AE$9:AE$15),MOD(AD$15,F$5)>0),MOD(AD$15,F$5),IF(AND(B9=SUM(AE$9:AE$17),MOD(AD$17,F$5)>0),MOD(AD$17,F$5),IF(AND(B9=SUM(AE$9:AE$19),MOD(AD$19,F$5)>0),MOD(AD$19,F$5),IF(AND(B9=SUM(AE$9:AE$21),MOD(AD$21,F$5)>0),MOD(AD$21,F$5),IF(AND(B9=SUM(AE$9:AE$23),MOD(AD$23,F$5)>0),MOD(AD$23,F$5),IF(AND(B9=SUM(AE$9:AE$25),MOD(AD$25,F$5)>0),MOD(AD$25,F$5),IF(AND(B9=SUM(AE$9:AE$27),MOD(AD$27,F$5)>0),MOD(AD$27,F$5),$F$5)))))))))),"")

Em xin cảm ơn

 

[ninhhai]

Em xin hỏi thêm một vấn đề nữa, cũng liên quan tới việc trích lọc dữ liệu bằng VBA.
Em có một Sheet có dữ liệu thay đổi. Mỗi khi thực hiện xong tính toán, em muốn xuất kết quả và tổng hợp qua sheet khác. Mong được các anh chị tư vấn giúp em.

Em xin chân thành cảm ơn.

Edit: Em nghĩ VD này không được " Excel" cho lắm nên có vẻ nan giải, nếu thay ("D13") từ " Số lớp" thành =("B12") thì sẽ dễ hơn.
Em cũng đã thử làm một phần là copy ("B13:B20") qua ("G16:G23"), nếu Cell trống hoặc giống nguồn thì copy đè lên, còn không thì Insert thêm 1 Cell và ghi dữ liệu vào đó. Nhưng loay hoay cả tối mà cũng chưa xong, không hiểu sao khi gặp điều kiện, có lúc thì nó chèn 1 Cell, có lúc thì lại chèn tới 5,6 cell. Bó tay.

 

[ninhhai]

Nếu các bác bận quá thì giúp em code copy B13:B20 sang G16:G21 sao cho nếu dữ liệu mới giống với dữ liệu đã có ở cột G thì bỏ qua, nếu khác thì chèn thêm hàng và copy vào cũng được.
Em xin cảm ơn.

 

[andredat]

Chào các anh chị,
Các anh chị giúp em viết code trong vba ý tưởng sau nha:
+ Em có một vùng dữ liệu gồm 2 sheet:
sheet "bán hàng" từ g5: h2000 trong đó cột g5: g2000 là mã khách hàng; cột h5:h2000 là tên khách hàng
Sheet "dskh" từ a5: b100 trong đó cột a5: a100 là mã khách hàng; cột b5:b100 là tên khách hàng
+ Em dùng sheet "bán hàng" làm vùng nhập liệu và sử dụng hàm vlookup giá trị trong sheet "dskh"
Nhưng vì số lượng lớn nên excel tính toán chậm nên em chuyển sang sử dụng code trong vba như sau:

Private Sub worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("g5: g2000")) Is Nothing Then
' dien ten khach hang
Worksheets("bán ra").Range("h5:h2000").Formula = "=if(RC[-1]="""","""",VLOOKUP(RC[-1],dskh!R1C1:R30000C2,2,0))"

Range("h5:h2000").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End if
End sub

Code chạy tốt nhưng em vẫn còn thấy chưa hoàn hảo. Nên nhờ các anh chị
+ Rút gọn đoạn code trên cho hợp lý hơn.
+ Vì mỗi lần em nhập hay thay đổi dữ liệu bất kỳ ô nào trong vùng g5:g2000 vì code phải làm việc nhiều quá. Vì thế em muốn khi thay đổi giá trị trong ô G5 thì chỉ có ô H5 bị tính toán lại chứ không phải cả vùng H5: H2000 và trong ô H6 chỉ thể hiện giá trị của công thức chứ không phải cả công thức lẫn giá trị để rồi thêm 1 bước pastespecial.
Rất mong được sự giúp đỡ của các anh chị.

 

[concogia]

Chào các anh chị,
Các anh chị giúp em viết code trong vba ý tưởng sau nha:
+ Em có một vùng dữ liệu gồm 2 sheet:
sheet "bán hàng" từ g5: h2000 trong đó cột g5: g2000 là mã khách hàng; cột h5:h2000 là tên khách hàng
Sheet "dskh" từ a5: b100 trong đó cột a5: a100 là mã khách hàng; cột b5:b100 là tên khách hàng
+ Em dùng sheet "bán hàng" làm vùng nhập liệu và sử dụng hàm vlookup giá trị trong sheet "dskh"
Nhưng vì số lượng lớn nên excel tính toán chậm nên em chuyển sang sử dụng code trong vba như sau:

Private Sub worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("g5: g2000")) Is Nothing Then
' dien ten khach hang
Worksheets("bán ra").Range("h5:h2000").Formula = "=if(RC[-1]="""","""",VLOOKUP(RC[-1],dskh!R1C1:R30000C2,2,0))"

Range("h5:h2000").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End if
End sub

Code chạy tốt nhưng em vẫn còn thấy chưa hoàn hảo. Nên nhờ các anh chị
+ Rút gọn đoạn code trên cho hợp lý hơn.
+ Vì mỗi lần em nhập hay thay đổi dữ liệu bất kỳ ô nào trong vùng g5:g2000 vì code phải làm việc nhiều quá. Vì thế em muốn khi thay đổi giá trị trong ô G5 thì chỉ có ô H5 bị tính toán lại chứ không phải cả vùng H5: H2000 và trong ô H6 chỉ thể hiện giá trị của công thức chứ không phải cả công thức lẫn giá trị để rồi thêm 1 bước pastespecial.
Rất mong được sự giúp đỡ của các anh chị.

Thử code này thử

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Ws As Worksheet, Cll As Range, Vung As Range
        Set Ws = Sheets("dskh")
        Set Vung = Ws.Range(Ws.[a1], Ws.[a1000].End(xlUp))
            If Not Intersect(Target, [g5:g2000]) Is Nothing Then
            On Error Resume Next
                If Target.Value <> "" Then
                    For Each Cll In Vung
                        If Cll.Value = Target.Value Then
                            Target.Offset(, 1) = Cll.Offset(, 1)
                            Exit For
                        End If
                    Next Cll
                End If
            End If
End Sub

Nhớ chép code này vào Sheet "banhang" nhé bạn
Thân

 

[andredat]

Thanks!Cảm ơn bác concogia rất nhiều. Em sẽ nghiên cứu kỹ và học được nhiều điều từ đoạn code của bác. Vì em còn nhiều điều chưa biết lắm nên sau này nhờ bác giúp đỡ.

 

[andredat]

Hiệu chỉnh code vba cho hoàn hảo

Chào các bác,
Nhờ các bác chuyển sang code vba giùm em file đính kèm. Vì em có viết code nhưng chưa hoàn hảo nên máy còn chạy chậm quá. Cảm ơn các bác