Copy dữ liệu từ 2 cột dồn vào 1 cột

Liên hệ QC

vova2209

Thành viên tích cực
Tham gia
5/4/17
Bài viết
825
Được thích
110
Giới tính
Nam
Nghề nghiệp
Đường bộ
Chào anh chị!
Nhờ anh chị giúp em sử lý copy dữ liệu cột F và cột H, đặt vào cột J2 .kết quả mong muốn như hình 1 và hình 2 bên dưới
và cách 2 lấy dữ liệu từ 2 cột E và cột G đặt sang cột J. bắt đầu từ ô J2 đặt kết quả

em xin cảm ơn..

Hình 1
111111.png

Hình 2
2222.png

Hình 3
33333333333.png
 

File đính kèm

  • Nhat Ky TC.xlsm
    268.3 KB · Đọc: 17
Lần chỉnh sửa cuối:
Chào anh chị!
Nhờ anh chị giúp em sử lý copy dữ liệu cột F và cột H, đặt vào cột J2 .kết quả mong muốn như hình 1 và hình 2 bên dưới
và cách 2 lấy dữ liệu từ 2 cột E và cột G đặt sang cột J. bắt đầu từ ô J2 đặt kết quả

em xin cảm ơn..

Hình 1
View attachment 265964

Hình 2
View attachment 265960

Hình 3
View attachment 265961
Nếu thích dùng công thức thì thử công thức củ chuối này xem sao. hy vọng đúng ý tuy hơi dài:
Mã:
J2=IF(INDEX($A$2:$H$31,ROW(A1)+1,6)<>"",INDEX($A$2:$H$31,ROW(A1)+1,6),IF(INDEX($A$2:$H$31,ROW()-COUNTIF($F$2:$F$1000,"<>"),8)<>"",INDEX($A$2:$H$31,ROW()-COUNTIF($F$2:$F$1000,"<>"),8),INDEX($A$2:$H$31,ROW()-COUNTIF($F$2:$F$1000,"<>")+1,8)))
enter và filldownl
 
Upvote 0
Nếu thích dùng công thức thì thử công thức củ chuối này xem sao. hy vọng đúng ý tuy hơi dài:
Mã:
J2=IF(INDEX($A$2:$H$31,ROW(A1)+1,6)<>"",INDEX($A$2:$H$31,ROW(A1)+1,6),IF(INDEX($A$2:$H$31,ROW()-COUNTIF($F$2:$F$1000,"<>"),8)<>"",INDEX($A$2:$H$31,ROW()-COUNTIF($F$2:$F$1000,"<>"),8),INDEX($A$2:$H$31,ROW()-COUNTIF($F$2:$F$1000,"<>")+1,8)))
enter và filldownl
Kết quả đang tìm thiếu mất 1 dòng đầu chị ạ. bị cộng 1 dòng trong công thức ở đâu, chị xem lại dùm em

Untitled.png
 
Upvote 0
Nếu thích dùng công thức thì thử công thức củ chuối này xem sao. hy vọng đúng ý tuy hơi dài:
Mã:
J2=IF(INDEX($A$2:$H$31,ROW(A1)+1,6)<>"",INDEX($A$2:$H$31,ROW(A1)+1,6),IF(INDEX($A$2:$H$31,ROW()-COUNTIF($F$2:$F$1000,"<>"),8)<>"",INDEX($A$2:$H$31,ROW()-COUNTIF($F$2:$F$1000,"<>"),8),INDEX($A$2:$H$31,ROW()-COUNTIF($F$2:$F$1000,"<>")+1,8)))
enter và filldownl
bị mất dòng đầu tiên chị ạ!
 
Upvote 0
bị mất dòng đầu tiên chị ạ!
Chỉnh sửa lại Sub của bạn một chút thành:
PHP:
Sub AutoNhatKy()

    Application.ScreenUpdating = False
    ActiveSheet.DisplayPageBreaks = False
        Dim Arr, arrF, arrH, ar As Variant, i, F, H As Long
    Dim R As Long, Rws As Long
With Sheets("Dau ra nhat ky")
        Union(.[F2:F9999], .[H2:H9999]).ClearContents    'Xoa giu lieu vung'
        Arr = .[E2:G9999]    'Vùng giu lieu E bat dau la cot 1'
        ReDim arrF(1 To UBound(Arr), 1 To 1), arrH(1 To UBound(Arr), 1 To 1)
        For i = 1 To UBound(Arr)
            If Arr(i, 1) <> "" Then F = F + 1: arrF(F, 1) = Arr(i, 1)   'Cot lay giu lieu E cho F la cot 1'
            If Arr(i, 3) <> "" Then H = H + 1: arrH(H, 1) = Arr(i, 3)   'Cot lay giu lieu G cho H la cot 3'
        Next
            .[F2:F9999] = arrF   'Chuyen giu lieu sang vung'
            .[H2:H9999] = arrH
        .[J2:J9999].Clear
        R = .Range("F10000").End(xlUp).Row
        If R > 1 Then .Range("F2:F" & R).Copy .Range("J2")
        R = .Range("H10000").End(xlUp).Row
        If R > 1 Then .Range("H2:H" & R).Copy .Range("J10000").End(xlUp).Offset(1)
End With
    Application.CutCopyMode = False
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Công thức này cũng được:
Mã:
J2=IF(ROW(F2)>MATCH("zzz",$F$1:$F$31),INDEX($H$2:$H$31,ROW(F2)-MATCH("zzz",$F$1:$F$31),),F2)
Cái trong ngoặc "zzz" là cái gì anh nhỉ. em xem hàm chưa hiểu lắm!
Bài đã được tự động gộp:

Chỉnh sửa lại Sub của bạn một chút thành:
PHP:
Sub AutoNhatKy()

    Application.ScreenUpdating = False
    ActiveSheet.DisplayPageBreaks = False
        Dim Arr, arrF, arrH, ar As Variant, i, F, H As Long
    Dim R As Long, Rws As Long
With Sheets("Dau ra nhat ky")
        Union(.[F2:F9999], .[H2:H9999]).ClearContents    'Xoa giu lieu vung'
        Arr = .[E2:G9999]    'Vùng giu lieu E bat dau la cot 1'
        ReDim arrF(1 To UBound(Arr), 1 To 1), arrH(1 To UBound(Arr), 1 To 1)
        For i = 1 To UBound(Arr)
            If Arr(i, 1) <> "" Then F = F + 1: arrF(F, 1) = Arr(i, 1)   'Cot lay giu lieu E cho F la cot 1'
            If Arr(i, 3) <> "" Then H = H + 1: arrH(H, 1) = Arr(i, 3)   'Cot lay giu lieu G cho H la cot 3'
        Next
            .[F2:F9999] = arrF   'Chuyen giu lieu sang vung'
            .[H2:H9999] = arrH
        .[J2:J9999].Clear
        R = .Range("F10000").End(xlUp).Row
        If R > 1 Then .Range("F2:F" & R).Copy .Range("J2")
        R = .Range("H10000").End(xlUp).Row
        If R > 1 Then .Range("H2:H" & R).Copy .Range("J10000").End(xlUp).Offset(1)
End With
    Application.CutCopyMode = False
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
Code chạy ngon rồi anh! em cảm ơn anh nhiều.
 
Upvote 0
Ngủ gật cũng được! chạy là khỏe rồi! cám ơn anh..
Mà góp ý bạn nhé, bạn vào diễn đàn cũng lâu rồi. 2017 đến giờ 4 năm rồi, bài viết là 701 nhưng tất cả bài viết đều hỏi bài, mình cũng đã gặp khá nhiều bài của bạn, mà câu hỏi thì không phải quá khó. Mình không có ý chỉ trích gì cả vì diễn đàn là nơi để trao đổi và học hỏi. Nhưng thiết nghĩ nếu Excel quan trọng trong công việc của bạn như vậy thì sao bạn không chịu khó học hỏi để tự mình làm được? Tự mình giải quyết những bài đơn giản theo nhu cầu của mình? Hay đơn giản là đôi khi copy code về cũng biết tùy biến một chút cho bản thân. Cái này là mình góp ý mong muốn tích cực cho bạn mà thôi, nhắc lại là mình không có ý chỉ trích gì bạn đâu nha, vì làm thế mình cũng chẳng giỏi lên!
 
Upvote 0
Mà góp ý bạn nhé, bạn vào diễn đàn cũng lâu rồi. 2017 đến giờ 4 năm rồi, bài viết là 701 nhưng tất cả bài viết đều hỏi bài, mình cũng đã gặp khá nhiều bài của bạn, mà câu hỏi thì không phải quá khó. Mình không có ý chỉ trích gì cả vì diễn đàn là nơi để trao đổi và học hỏi. Nhưng thiết nghĩ nếu Excel quan trọng trong công việc của bạn như vậy thì sao bạn không chịu khó học hỏi để tự mình làm được? Tự mình giải quyết những bài đơn giản theo nhu cầu của mình? Hay đơn giản là đôi khi copy code về cũng biết tùy biến một chút cho bản thân. Cái này là mình góp ý mong muốn tích cực cho bạn mà thôi, nhắc lại là mình không có ý chỉ trích gì bạn đâu nha, vì làm thế mình cũng chẳng giỏi lên!
Vâng! cảm ơn những góp ý của anh.
Em cũng bận nhiều việc nên lúc cần gấp lên diễn đàn nhờ các anh chị giải luôn cho. Ngày đi học dưới Hà Nội thì không biết lợi ích của office, giờ đi làm mắc đến đâu tìm hiểu đến đấy. em cũng tự viết và chỉnh sửa được 1 ít cơ bản, code rễ thôi. cảm ơn anh chị ở diễn đàn luôn luôn giúp đỡ em!
 
Upvote 0
Mà góp ý bạn nhé, bạn vào diễn đàn cũng lâu rồi. 2017 đến giờ 4 năm rồi, bài viết là 701 nhưng tất cả bài viết đều hỏi bài, mình cũng đã gặp khá nhiều bài của bạn, mà câu hỏi thì không phải quá khó. Mình không có ý chỉ trích gì cả vì diễn đàn là nơi để trao đổi và học hỏi. Nhưng thiết nghĩ nếu Excel quan trọng trong công việc của bạn như vậy thì sao bạn không chịu khó học hỏi để tự mình làm được? Tự mình giải quyết những bài đơn giản theo nhu cầu của mình? Hay đơn giản là đôi khi copy code về cũng biết tùy biến một chút cho bản thân. Cái này là mình góp ý mong muốn tích cực cho bạn mà thôi, nhắc lại là mình không có ý chỉ trích gì bạn đâu nha, vì làm thế mình cũng chẳng giỏi lên!
Câu góp ý này hơi ngây thơ.
Tại vì quý vị sốt sắng quá, viết code từ a đến z cho nên người ta tự thấy không cần học hỏi thêm gì cả.

Đó là lý do tôi bình thường chỉ viết một phần code. Người hỏi bắt buộc phải viết thêm mấy phần căn bản khác.
Tuy nhiên, cách thức này của tôi cũng chả hiệu nghiệm mấy. Người hỏi ở diễn đàn này quen rồi thì biết "rừng luôn còn nhiều củi", "không mợ chợ cũng đông". Một thằng viết vắn tắt thì cứ kệ tía nó. Trung bình một bài hỏi có đến 2-3 người sẵn sàng viết code từ a đến z.
 
Upvote 0
Tuy nhiên, cách thức này của tôi cũng chả hiệu nghiệm mấy. Người hỏi ở diễn đàn này quen rồi thì biết "rừng luôn còn nhiều củi", "không mợ chợ cũng đông". Một thằng viết vắn tắt thì cứ kệ tía nó. Trung bình một bài hỏi có đến 2-3 người sẵn sàng viết code từ a đến z.
Không phải ai cũng thế đâu chú ạ. Cháu thấy nhiều bạn vẫn chịu học mà
 
Upvote 0
Câu góp ý này hơi ngây thơ.
Tại vì quý vị sốt sắng quá, viết code từ a đến z cho nên người ta tự thấy không cần học hỏi thêm gì cả.

Đó là lý do tôi bình thường chỉ viết một phần code. Người hỏi bắt buộc phải viết thêm mấy phần căn bản khác.
Tuy nhiên, cách thức này của tôi cũng chả hiệu nghiệm mấy. Người hỏi ở diễn đàn này quen rồi thì biết "rừng luôn còn nhiều củi", "không mợ chợ cũng đông". Một thằng viết vắn tắt thì cứ kệ tía nó. Trung bình một bài hỏi có đến 2-3 người sẵn sàng viết code từ a đến z.
Bạn thông cảm, không viết 1 phần code mà viết từ a đến z vì nhiều lý do:
- Viết 1 phần không biết code có chạy đúng không
- Rất nhiều bạn trên diễn đàn trong đó có mình không được học bài bản nên không có căn bản VBA, không biết căn bản VBA gồm những gì và không đoán được người hỏi có thể viết được gì
- Người viết với mục đích luyện code, nên đưa toàn bộ lệnh để các thành viên khác góp ý hoàn thiện
- Ngại trả lời nhiều lần
 
Upvote 0
Chỉnh sửa lại Sub của bạn một chút thành:
PHP:
Sub AutoNhatKy()

    Application.ScreenUpdating = False
    ActiveSheet.DisplayPageBreaks = False
        Dim Arr, arrF, arrH, ar As Variant, i, F, H As Long
    Dim R As Long, Rws As Long
With Sheets("Dau ra nhat ky")
        Union(.[F2:F9999], .[H2:H9999]).ClearContents    'Xoa giu lieu vung'
        Arr = .[E2:G9999]    'Vùng giu lieu E bat dau la cot 1'
        ReDim arrF(1 To UBound(Arr), 1 To 1), arrH(1 To UBound(Arr), 1 To 1)
        For i = 1 To UBound(Arr)
            If Arr(i, 1) <> "" Then F = F + 1: arrF(F, 1) = Arr(i, 1)   'Cot lay giu lieu E cho F la cot 1'
            If Arr(i, 3) <> "" Then H = H + 1: arrH(H, 1) = Arr(i, 3)   'Cot lay giu lieu G cho H la cot 3'
        Next
            .[F2:F9999] = arrF   'Chuyen giu lieu sang vung'
            .[H2:H9999] = arrH
        .[J2:J9999].Clear
        R = .Range("F10000").End(xlUp).Row
        If R > 1 Then .Range("F2:F" & R).Copy .Range("J2")
        R = .Range("H10000").End(xlUp).Row
        If R > 1 Then .Range("H2:H" & R).Copy .Range("J10000").End(xlUp).Offset(1)
End With
    Application.CutCopyMode = False
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT
Back
Top Bottom