[Giúp]: Xin code copy từ sheet này sang sheet khác, với cột chỉ định (1 người xem)

[timhieu02]

Em chào các anh chị,

Em có 1 file dữ liệu với nhiều cột, nhưng chỉ cần báo cáo 1 vào cột chủ yếu. Nếu dùng hàm excel tham chiếu lấy từng cột thì sẽ có thể sai sót.
Nên cho em xin code với. Em có đính kèm file ví dụ và kết quả mong muốn sau khi chạy macro.

- Sheet "Data": là data tổng, với nhiều dòng và nhiều cột. Ở đây em chỉ lấy ví dụ 1 ít dữ liệu thôi
- Sheet "Key report": trong đó
-> Dòng số 1: là em sẽ nhập tên cột cần copy dữ liệu sang (tên cột này là tên tương ứng với tên trên thanh A, B, C, D...của excel)
-> Những ô ở dòng dòng số 1 không có nhập tên cột, thì không copy dữ liệu
-> khi copy thì giữ nguyên format dữ liệu như ban đầu ở sheet "Data"
- Sheet "kết quả sau khi chạy macro": là kết quả sau khi chạy macro. Sheet này tham khảo thôi. thật ra sau khi chạy macro, thì dữ liệu sẽ copy sang sheet "Key report" ở trên

Do em có nhiều file dữ liệu khác nhau, nên tên cột cần copy cũng sẽ khác nhau.
Chính vì vậy mà em xin code để khi nhập tên cột thì code sẽ dò và copy dữ lệu những cột đó.

Mong tin từ các anh chị.

 

[SA_DQ]

Bạn chạy Macro này để có kết quả & những mong là không cần chuyển file tới bạn;
Chúc thành công!

Sub CopyCacCotTheoChiDinh()
Dim Rws As Long, J As Integer, Col As Integer

Sheets("Key report").Select
[B3].CurrentRegion.Offset(1).ClearContents 'Xóa Du Liêu Lân Truóc Copy    '
With Sheets("Data")
    Rws = .[B4].CurrentRegion.Rows.Count    'Xác Dinh Sô Dòng Cua DL Cân Copy   '
    For J = 1 To 8
1 'Xác Dinh Côt Tuong Úng Cân Copy Sang:  '
        Col = Switch(J = 1, 1, J = 2, 9, J = 3, 3, J = 4, 13, J = 5, 2, J = 6, 5, J = 7, 13, J = 8, 8)
2 ' Thuc Hiên Viêc Copy:  '
        If J <> 4 Or J <> 7 Then
            .Cells(4, Col).Resize(Rws).Copy Destination:=Cells(4, J)
        End If
    Next J
End With
End Sub

 

[timhieu02]

Bạn chạy Macro này để có kết quả & những mong là không cần chuyển file tới bạn;
Chúc thành công!

Sub CopyCacCotTheoChiDinh()
Dim Rws As Long, J As Integer, Col As Integer

Sheets("Key report").Select
[B3].CurrentRegion.Offset(1).ClearContents 'Xóa Du Liêu Lân Truóc Copy    '
With Sheets("Data")
    Rws = .[B4].CurrentRegion.Rows.Count    'Xác Dinh Sô Dòng Cua DL Cân Copy   '
    For J = 1 To 8
1 'Xác Dinh Côt Tuong Úng Cân Copy Sang:  '
        Col = Switch(J = 1, 1, J = 2, 9, J = 3, 3, J = 4, 13, J = 5, 2, J = 6, 5, J = 7, 13, J = 8, 8)
2 ' Thuc Hiên Viêc Copy:  '
        If J <> 4 Or J <> 7 Then
            .Cells(4, Col).Resize(Rws).Copy Destination:=Cells(4, J)
        End If
    Next J
End With
End Sub

Dạ. em xi lỗi vì giờ này mới trả lời vì em biết anh dậy rất sáng sớm để giúp đỡ code cho em.

Anh ơi, anh đừng giận em. em quên báo là: ở sheet "Key report", row 1, em sẽ điền tên cột bất kỳ, tùy theo mỗi file data của dự án. Dòng 1 này là chính và mấu chốt để copy data từ sheet "Data". Còn row 3 thì không cần quan tâm để chạy code.

Có gì anh chỉnh lại giúp em nhé

Trân trọng.

 

[SA_DQ]

Cái quên báo đó cần thể hiện lại trong file mới, lúc đó may ra mới có Code mới.

 

[Ba Tê]

Dạ. em xi lỗi vì giờ này mới trả lời vì em biết anh dậy rất sáng sớm để giúp đỡ code cho em.

Anh ơi, anh đừng giận em. em quên báo là: ở sheet "Key report", row 1, em sẽ điền tên cột bất kỳ, tùy theo mỗi file data của dự án. Dòng 1 này là chính và mấu chốt để copy data từ sheet "Data". Còn row 3 thì không cần quan tâm để chạy code.

Có gì anh chỉnh lại giúp em nhé

Trân trọng.

- Bạn nên "quên" chuyện ghi theo tên cột A,B,C... mà nên ghi theo số cột 1,2,3... như dòng 4 trong file.
- Tìm đâu ra cái "mả" của sản phẩm, của khách hàng vậy? Quê tôi khi chết, người thân xây cho cái mả tốn nhiều tiền lắm đấy.

 

[SA_DQ]

Một cách khác: Chỉ cần ghi tên trường giống với tên trường của trang 'Data' là được:

Public Sub MyGPE()
 Dim Rng As Range, sRng As Range, Sh As Worksheet
 Dim I As Long, J As Long, R As Long, CoL As Long
     
 Set Sh = ThisWorkbook.Worksheets("Data")
 R = Sh.[b4].CurrentRegion.Rows.Count
 Set Rng = Sh.Range(Sh.[A3], Sh.[A3].End(xlToRight)):
 With Sheets("Key report")
    For J = 1 To 99
        If .Cells(3, J).Value = "" Then
            Exit For
        Else
            Set sRng = Rng.Find(.Cells(3, J).Value, , xlFormulas, xlWhole)
            If Not sRng Is Nothing Then
                Sh.Cells(5, sRng.Column).Resize(R).Copy Destination:=.Cells(4, J)
            End If
        End If
    Next J
 End With
End Sub

 

[timhieu02]

Dạ. em cảm ơn anh @Ba Tê @SA_DQ nhiều lắm.

- Bạn nên "quên" chuyện ghi theo tên cột A,B,C... mà nên ghi theo số cột 1,2,3... như dòng 4 trong file.
- Tìm đâu ra cái "mả" của sản phẩm, của khách hàng vậy? Quê tôi khi chết, người thân xây cho cái mả tốn nhiều tiền lắm đấy.

Hihihi..em cảm ơn anh @Ba Tê ạ. sai lỗi chính tả đúng là tai hại thật!
Anh ơi, em có nổi khổ ở bài toán này, vì file report này, ngoài em ra, còn có 1 số người khác câp nhật nữa. Mà các bạn em chỉ quen việc nhập tên cột A, B, C, ..như trong dòng số 1 ở sheet "Key report". Anh có cách nào giúp em với. Em có đính kèm lại file mẫu ạ.

Bài đã được tự động gộp: 19/7/19

Một cách khác: Chỉ cần ghi tên trường giống với tên trường của trang 'Data' là được:

Public Sub MyGPE()
Dim Rng As Range, sRng As Range, Sh As Worksheet
Dim I As Long, J As Long, R As Long, CoL As Long
    
Set Sh = ThisWorkbook.Worksheets("Data")
R = Sh.[b4].CurrentRegion.Rows.Count
Set Rng = Sh.Range(Sh.[A3], Sh.[A3].End(xlToRight)):
With Sheets("Key report")
    For J = 1 To 99
        If .Cells(3, J).Value = "" Then
            Exit For
        Else
            Set sRng = Rng.Find(.Cells(3, J).Value, , xlFormulas, xlWhole)
            If Not sRng Is Nothing Then
                Sh.Cells(5, sRng.Column).Resize(R).Copy Destination:=.Cells(4, J)
            End If
        End If
    Next J
End With
End Sub

Dạ. em cảm ơn anh @SA_DQ nhiều lắm. Do dữ liệu ở sheet "Data", (data thật tế) sẽ có 1 số cột có các header bị trùng nhau. Và header ở sheet "Key report" , tụi em cần chỉnh lại tên cho rõ nghĩa nữa. Nên em chỉ nhập tên cột A, B, C, ...ở dòng 1 - cần lấy data thôi ạ.

Có gì anh nhín chút thời gian giúp em với. Em có đính kèm lại file mẫu ban đầu ạ

 

[Ba Tê]

Mà các bạn em chỉ quen việc nhập tên cột A, B, C, ..

Bảo các bạn thay đổi thói quen. Nếu không thì để các bạn tự xoay sở.
Tôi chỉ làm được như vậy thôi.

 

[timhieu02]

Bảo các bạn thay đổi thói quen. Nếu không thì để các bạn tự xoay sở.
Tôi chỉ làm được như vậy thôi.

Dạ anh. Chúc anh @Ba Tê ngủ ngon ạ.

 

[SA_DQ]

Giận thì giận, mà thương thì thương; Anh sai đường em không chịu nổi; Anh ơi anh xin dừng có zận dỗi, . . . .

Const Alf As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Sub CopyCacCotTheoMaCotChiDinh()
Dim Rws As Long, J As Integer, Col As Integer

Sheets("Key report").Select
[B3].CurrentRegion.Offset(1).ClearContents
With Sheets("Data")
    Rws = .[B4].CurrentRegion.Rows.Count
    For J = 1 To Cells(1, 35).End(xlToLeft).Column
        Col = InStr(Alf, Cells(1, J).Value)
        If Col Then
            .Cells(4, Col).Resize(Rws).Copy Destination:=Cells(4, J)
        End If
    Next J
End With
End Sub

 

[timhieu02]

Giận thì giận, mà thương thì thương; Anh sai đường em không chịu nổi; Anh ơi anh xin dừng có zận dỗi, . . . .

Const Alf As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Sub CopyCacCotTheoMaCotChiDinh()
Dim Rws As Long, J As Integer, Col As Integer

Sheets("Key report").Select
[B3].CurrentRegion.Offset(1).ClearContents
With Sheets("Data")
    Rws = .[B4].CurrentRegion.Rows.Count
    For J = 1 To Cells(1, 35).End(xlToLeft).Column
        Col = InStr(Alf, Cells(1, J).Value)
        If Col Then
            .Cells(4, Col).Resize(Rws).Copy Destination:=Cells(4, J)
        End If
    Next J
End With
End Sub

Em cảm ơn anh @SA_DQ ! nó đã chạy rồi. Em test thì còn 2 ý nữa là về đích bài toán này của em rồi
- Chỉ cho phép copy những cột được chỉnh định. Hiện tại những cột không có nhập tên cột thì nó tự động copy dữ liệu cột đầu tiên bên sheet "Data"
- Dữ liệu thật tế của em thì có rất nhiều cột (hàng trăm cột), nên nên những tên cột như là "AA", "AB", "ADX", v.v..thì macro không copy được.

Mong anh giúp em thêm tí nữa nhé (Do là cuối tuần, sau khi anh dành thời gian cho gia đình của anh xong, công việc của anh xong, thì anh hãy giúp em sau nhé )

 

[Ba Tê]

Em cảm ơn anh @SA_DQ ! nó đã chạy rồi. Em test thì còn 2 ý nữa là về đích bài toán này của em rồi
- Chỉ cho phép copy những cột được chỉnh định. Hiện tại những cột không có nhập tên cột thì nó tự động copy dữ liệu cột đầu tiên bên sheet "Data"
- Dữ liệu thật tế của em thì có rất nhiều cột (hàng trăm cột), nên nên những tên cột như là "AA", "AB", "ADX", v.v..thì macro không copy được.

Mong anh giúp em thêm tí nữa nhé (Do là cuối tuần, sau khi anh dành thời gian cho gia đình của anh xong, công việc của anh xong, thì anh hãy giúp em sau nhé )

Nếu bạn vẫn "cố chấp" với cách ghi tên cột, A, Z, AB,XFA... thì cũng phải có 1 hàm "dịch" Tên cột thành Số cột mà thôi.
Bạn xem file, trong đó có 1 Hàm "Cùi bắp" để làm chuyện này. (Cùi bắp là vì tôi chưa từng xử chuyện oái oăm này)

 

[khongtu19bk]

Nếu bạn vẫn "cố chấp" với cách ghi tên cột, A, Z, AB,XFA... thì cũng phải có 1 hàm "dịch" Tên cột thành Số cột mà thôi.
Bạn xem file, trong đó có 1 Hàm "Cùi bắp" để làm chuyện này. (Cùi bắp là vì tôi chưa từng xử chuyện oái oăm này)

Với code của anh:

Public Function SoCot(ByVal TenCot As String) As Long
Dim J As Long, X As String
For J = 1 To 1000
    X = Replace(Replace(Cells(1, J).Address, "$", ""), 1, "")
    If X = UCase(TenCot) Then
        SoCot = J
        Exit For
    End If
Next J
End Function

phải chạy vòng lặp 1000 lần. Hơn nữa nếu cột vượt quá 1000 thì không đáp ứng được.
Vì lý do đó, em xin đóng góp code sau:
'Input: Nhập vào tên cột. Ex: AA
'Output: cho ra thông báo số cột bằng SỐ

Sub tuhocvba()
    Dim s As String
    s = "AXA"
    s = s & "$1"
    MsgBox Range(s).Column
End Sub

Kết quả:

 

[befaint]

s = s & "$1"

Không có đô la có được không bạn?

 

[khongtu19bk]

Không có đô la có được không bạn?

Không có đô la thì nghèo thôi, còn vẫn được
Bỏ đô la đi , nhưng đừng quên gõ 1 vào nhé.

Sub tuhocvba()
    Dim s As String
    s = "AXA"
    s = s & "1"
    MsgBox Range(s).Column
End Sub

 

[befaint]

Không có đô la thì nghèo thôi, còn vẫn được
Bỏ đô la đi , nhưng đừng quên gõ 1 vào nhé.

Sub tuhocvba()
    Dim s As String
    s = "AXA"
    s = s & "1"
    MsgBox Range(s).Column
End Sub

Nếu mình chuyển thành một function hoàn chỉnh thì như nào bạn?

 

[khongtu19bk]

Nếu mình chuyển thành một function hoàn chỉnh thì như nào bạn?

'INPUT: ex: AA
'OUTPUT: chi ra cot bang so
'Neu ham co gia tri = 0 tuc la dang bi loi, dia chi cot nhap sai.
Function timdiachicot(ByVal s As String) As integer
    Dim i As Integer
    On Error Resume Next
    timdiachicot = 0
    i = Range(s & "1").Column
    timdiachicot = i
End Function
Sub tuhocvba_2()
    MsgBox timdiachicot("ADFFFF")
End Sub

 

[befaint]

On Error Resume Next

Có cách nào khác ngoài cách dùng lệnh này không bạn? Mình thấy mấy anh lớn tuổi kêu không nên dùng lệnh đó.

 

[khongtu19bk]

Có cách nào khác ngoài cách dùng lệnh này không bạn? Mình thấy mấy anh lớn tuổi kêu không nên dùng lệnh đó.

Mình xin phép dừng thảo luận ở đây vì lý do tiếp tục thảo luận là bất minh.
Tại sao bạn không hỏi mấy anh lớn tuổi, những người kêu bạn không nên dùng lệnh đó ấy.
-Lý do?
-Phương án thay thế?
Áp dụng: Trong trường hợp cụ thể này, dùng lệnh đó thì điều bất an gì sẽ xảy ra?

 

[befaint]

Mình xin phép dừng thảo luận ở đây vì lý do tiếp tục thảo luận là bất minh.

"bất minh"

Nghĩa là: không rõ ràng, có chỗ đáng nghi ngờ.

Ví dụ: 'Quan hệ' bất minh, 'thảo luận' bất minh.

Từ đồng nghĩa: ám muội, đen tối, khuất tất, mờ ám.

Từ trái nghĩa: minh bạch.
---
Đang thảo luận 'lộ thiên' thế này mà lại kêu 'bất minh'. Oan thị bưởi ghê.

 

[khongtu19bk]

"bất minh"

Nghĩa là: không rõ ràng, có chỗ đáng nghi ngờ.

Ví dụ: 'Quan hệ' bất minh, 'thảo luận' bất minh.

Từ đồng nghĩa: ám muội, đen tối, khuất tất, mờ ám.

Từ trái nghĩa: minh bạch.
---
Đang thảo luận 'lộ thiên' thế này mà lại kêu 'bất minh'. Oan thị bưởi ghê.

Bạn có nghĩ rằng lý do bạn đưa ra là thuyết phục để tiếp tục thảo luận không?
Tôi không nghĩ thế. Đứng trên góc độ học thuật, bạn cần chỉ ra lý do, điều gì sẽ xảy ra, chứ không phải vì anh này hay bác kia bảo thế nên tôi nhất định không xài. Với lý do như thế, tôi không có cách nào thảo luận tiếp tục được.
Nếu On Error khiến bạn lo lắng như thế, tôi xin phép dùng video sau thay cho lời thuyết minh.
Nếu không phải vấn đề học thuật, tôi sẽ không thảo luận.

 

[Ba Tê]

phải chạy vòng lặp 1000 lần. Hơn nữa nếu cột vượt quá 1000 thì không đáp ứng được.

- Tôi có nói là chưa từng xử lý chuyện này nên nghĩ sao viết vậy, thấy bạn ấy nói dữ liệu khoảng 200 cột nên lấy số 1000.
- Với cách lấy Column như bạn thì có thể viết Function thế này.

Public Function SoCot(TenCot As String) As Long
On Error Resume Next
    SoCot = Range(TenCot & 1).Column
End Function

- Chuyện kết quả =0 sẽ giải quyết trong Sub.

 

[khongtu19bk]

- Tôi có nói là chưa từng xử lý chuyện này nên nghĩ sao viết vậy, thấy bạn ấy nói dữ liệu khoảng 200 cột nên lấy số 1000.
- Với cách lấy Column như bạn thì có thể viết Function thế này.

Public Function SoCot(TenCot As String) As Long
On Error Resume Next
    SoCot = Range(TenCot & 1).Column
End Function

- Chuyện kết quả =0 sẽ giải quyết trong Sub.

Vâng ạ. Em thấy hàm trên của anh chạy không có vấn đề gì ạ. Cách viết như của anh trông gọn hơn em nhỉ.

 

[PacificPR]

Bạn có nghĩ rằng lý do bạn đưa ra là thuyết phục để tiếp tục thảo luận không?
Tôi không nghĩ thế. Đứng trên góc độ học thuật, bạn cần chỉ ra lý do, điều gì sẽ xảy ra, chứ không phải vì anh này hay bác kia bảo thế nên tôi nhất định không xài. Với lý do như thế, tôi không có cách nào thảo luận tiếp tục được.
Nếu On Error khiến bạn lo lắng như thế, tôi xin phép dùng video sau thay cho lời thuyết minh.
Nếu không phải vấn đề học thuật, tôi sẽ không thảo luận.

Cái video này không thuyết phục được Anh í đâu. Hình như Anh í là người khó tính thứ 3 trong diễn đàn này đó ạ

 

[khongtu19bk]

Cái video này không thuyết phục được Anh í đâu. Hình như Anh í là người khó tính thứ 3 trong diễn đàn này đó ạ

Mình sẽ chú ý để không tham gia vào những thảo luận không cần thiết.

 

[timhieu02]

Nếu bạn vẫn "cố chấp" với cách ghi tên cột, A, Z, AB,XFA... thì cũng phải có 1 hàm "dịch" Tên cột thành Số cột mà thôi.
Bạn xem file, trong đó có 1 Hàm "Cùi bắp" để làm chuyện này. (Cùi bắp là vì tôi chưa từng xử chuyện oái oăm này)

Dạ. em cảm ơn anh @Ba Tê nhiều lắm. Dạ được rồi anh ơi. Chạy đã lắm

Bài đã được tự động gộp: 21/7/19

Em cảm ơn các anh đã đóng góp cho bài toán khó của em đã được giải quyết! Em biết mỗi người đều có sở trường riêng của mình. Em mong các anh đừng vì topic của em mà mất hòa khí.

Chúng ta là 1 gia đình!

p/s: @PacificPR thấy ít lên thớt nhưng comment không kém phần lém lỉnh!

 

[ThangCuAnh]

Uhm, nhìn avatar xinh gái quá nhỉ. Không biết là hình thật hay hình cô Hàn xẻng nào đây

 

[snow25]

Uhm, nhìn avatar xinh gái quá nhỉ. Không biết là hình thật hay hình cô Hàn xẻng nào đây

Anh ơi anh nói ai vậy.Ít ra phải có dẫn chứng chứ anh.Anh toàn nói vu vơ không à.

 

[ThangCuAnh]

Hì hì, thì avatar của @PacificPR đó

 

[VetMini]

Cái video này không thuyết phục được Anh í đâu. Hình như Anh í là người khó tính thứ 3 trong diễn đàn này đó ạ

Anh í là ai vậy? Ính lít và I ta liên?

 

[be_09]

............................
- Dữ liệu thật tế của em thì có rất nhiều cột (hàng trăm cột), nên nên những tên cột như là "AA", "AB", "ADX", v.v..thì macro không copy được.
.............................

Nếu sheet "Data" thực tế có hàng trăm cột dữ liệu và có 1 số cột có tiêu đề trùng nhau là kiểu theo dõi chưa hợp lý, trên diễn đàn cũng đã từng có thành viên theo dõi 1 sheet đến cả ngàn cột.
Tôi thường khuyên là nên đưa File với tiêu đề thực tế lên để các thành viên có nhiều kinh nghiệm thiết kế lại thì sẽ hay hơn là áp dụng theo kiểu cũ của bạn.