Insert Collume

winnies · 12/10/18

Dear cả nhà,

Mình có 1 trường hợp này nhờ cả nhà giúp

Mình muốn chuyển thành

có cách này làm cho nhanh khong ah. Vì nếu làm thủ công thì lâu quá nếu số lượng lớn

snow25 · 12/10/18

winnies đã viết:
Dear cả nhà,

Mình có 1 trường hợp này nhờ cả nhà giúp

View attachment 205570

Mình muốn chuyển thành
View attachment 205571

có cách này làm cho nhanh khong ah. Vì nếu làm thủ công thì lâu quá nếu số lượng lớn

bạn gửi file lên đây

saobekhonglac · 12/10/18

snow25 đã viết:
bạn gửi file lên đây

Gửi dùm chủ thớt luôn. Suy nghĩ hoài mà không ra, làm hết cột A rồi tới cột B, C thì biết. Cái này chịu

snow25 · 12/10/18

winnies đã viết:
Dear cả nhà,

Mình có 1 trường hợp này nhờ cả nhà giúp

View attachment 205570

Mình muốn chuyển thành
View attachment 205571

có cách này làm cho nhanh khong ah. Vì nếu làm thủ công thì lâu quá nếu số lượng lớn

đây bạn xem code VBA nó đơn giản thôi nhé

nguyenthuy13388 · 12/10/18

snow25 đã viết:
đây bạn xem code VBA nó đơn giản thôi nhé

Rút gọn code đi 1 chút, tuy nhiên mình không nghĩ bài này đơn giản như thế đâu, trường hợp có 2a mà không phải 3a thì làm sao đây

Mã:

Sub thaydoi()
Application.ScreenUpdating = False
Dim i, j, k As Long
Dim a, b, c As Long
a = Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Row
b = 2
For i = 2 To a Step 3
    Range(Cells(i, 1), Cells(i + 2, 1)).Copy (Cells(b, 4))
    b = b + 3
    Range(Cells(i, 2), Cells(i + 2, 2)).Copy (Cells(b, 4))
    b = b + 3
    Range(Cells(i, 3), Cells(i + 2, 3)).Copy (Cells(b, 4))
    b = b + 3
Next i
Application.CutCopyMode = False
End Sub

snow25 · 12/10/18

nguyenthuy13388 đã viết:
Rút gọn code đi 1 chút, tuy nhiên mình không nghĩ bài này đơn giản như thế đâu, trường hợp có 2a mà không phải 3a thì làm sao đây

Mã:

Sub thaydoi() Application.ScreenUpdating = False Dim i, j, k As Long Dim a, b, c As Long a = Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Row b = 2 For i = 2 To a Step 3 Range(Cells(i, 1), Cells(i + 2, 1)).Copy (Cells(b, 4)) b = b + 3 Range(Cells(i, 2), Cells(i + 2, 2)).Copy (Cells(b, 4)) b = b + 3 Range(Cells(i, 3), Cells(i + 2, 3)).Copy (Cells(b, 4)) b = b + 3 Next i Application.CutCopyMode = False End Sub

à cái đấy thì mình lại xét điều kiện thôi không dùng bước nhảy này nữa

giaiphap · 12/10/18

nguyenthuy13388 đã viết:
Rút gọn code đi 1 chút, tuy nhiên mình không nghĩ bài này đơn giản như thế đâu, trường hợp có 2a mà không phải 3a thì làm sao đây

Mã:

Sub thaydoi() Application.ScreenUpdating = False Dim i, j, k As Long Dim a, b, c As Long a = Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Row b = 2 For i = 2 To a Step 3 Range(Cells(i, 1), Cells(i + 2, 1)).Copy (Cells(b, 4)) b = b + 3 Range(Cells(i, 2), Cells(i + 2, 2)).Copy (Cells(b, 4)) b = b + 3 Range(Cells(i, 3), Cells(i + 2, 3)).Copy (Cells(b, 4)) b = b + 3 Next i Application.CutCopyMode = False End Sub

Cách này sẽ chậm nếu dữ liệu lớn, bạn viết lại code cho nhanh hơn và giải quyết luôn cái vấn đề bạn phát hiện luôn đi, phát sinh thêm nửa là không phải 3 cột mà là 4 hoặc 5 cột gì đó.

VetMini · 12/10/18

Thắc mắc: "Dear" thì có lẽ là tiếng Anh rồi. Còn "Collume" thì là tiếng nước nào hay bộ tộc nào nhỉ?

snow25 · 13/10/18

nguyenthuy13388 đã viết:
Rút gọn code đi 1 chút, tuy nhiên mình không nghĩ bài này đơn giản như thế đâu, trường hợp có 2a mà không phải 3a thì làm sao đây

Mã:

Sub thaydoi() Application.ScreenUpdating = False Dim i, j, k As Long Dim a, b, c As Long a = Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Row b = 2 For i = 2 To a Step 3 Range(Cells(i, 1), Cells(i + 2, 1)).Copy (Cells(b, 4)) b = b + 3 Range(Cells(i, 2), Cells(i + 2, 2)).Copy (Cells(b, 4)) b = b + 3 Range(Cells(i, 3), Cells(i + 2, 3)).Copy (Cells(b, 4)) b = b + 3 Next i Application.CutCopyMode = False End Sub

đây bạn xem có hợp lý không nhé

Mã:

Sub thaydoi()
Application.ScreenUpdating = False
Dim i, j, k As Long
Dim a, b, c As Long
a = Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Row
i = 2
b = 1
c = 2
While i < a
  For j = i To a
    If Cells(j, 1).Value = Cells(j + 1, 1).Value Then
     b = b + 1
     Else
     Exit For
     End If
  Next j
Range(Cells(i, 1), Cells(i + b - 1, 1)).Copy (Cells(c, 4))
c = c + b
Range(Cells(i, 2), Cells(i + b - 1, 2)).Copy (Cells(c, 4))
c = c + b
Range(Cells(i, 3), Cells(i + b - 1, 3)).Copy (Cells(c, 4))
c = c + b
i = i + b
b = 1
Wend
Application.CutCopyMode = False
End Sub

♫ђöล♥ßล†♥†µ♫ · 13/10/18

Em tham gia chút cho vui. Bỏ mấy ngày chữ Thầy lại trả Thầy mất rồi. Viết mãi mới ra được cái đoạn này

PHP:

Sub thaydoi()
    Dim Base_column As Long, C As Long
    Dim sArr As Variant, dArr As Variant, I As Long, J As Long, K As Long, R As Long
    Dim Dic As Object, v As Variant, Key As String, Item, aTmp, Idx
Set Dic = CreateObject("Scripting.Dictionary")
Base_column = 1: C = 3
sArr = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, C).Value
R = UBound(sArr) * C
If R < Rows.Count Then
    ReDim dArr(1 To R, 1 To 1)
    For I = LBound(sArr) To UBound(sArr)
        Key = sArr(I, Base_column)
        If Not Dic.Exists(Key) Then
            Dic.Add Key, I
        Else
            Item = Dic.Item(Key) & "@#@" & I
            Dic.Remove Key:   Dic.Add Key, Item
        End If
    Next I
    For Each v In Dic.Keys()
        aTmp = Dic.Item(v)
        For J = 1 To C
            For Each Idx In Split(aTmp, "@#@")
                K = K + 1
                dArr(K, 1) = sArr(CLng(Idx), J)
            Next
        Next J
    Next v
    Range("E2").Resize(K) = dArr
Else
    MsgBox "Du lieu qua lon"
End If
End Sub

HieuCD · 13/10/18

♫ђöล♥ßล†♥†µ♫ đã viết:

Em tham gia chút cho vui. Bỏ mấy ngày chữ Thầy lại trả Thầy mất rồi. Viết mãi mới ra được cái đoạn này

PHP:

Sub thaydoi()
    Dim Base_column As Long, C As Long
    Dim sArr As Variant, dArr As Variant, I As Long, J As Long, K As Long, R As Long
    Dim Dic As Object, v As Variant, Key As String, Item, aTmp, Idx
Set Dic = CreateObject("Scripting.Dictionary")
Base_column = 1: C = 3
sArr = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, C).Value
R = UBound(sArr) * C
If R < Rows.Count Then
    ReDim dArr(1 To R, 1 To 1)
    For I = LBound(sArr) To UBound(sArr)
        Key = sArr(I, Base_column)
        If Not Dic.Exists(Key) Then
            Dic.Add Key, I
        Else
            Item = Dic.Item(Key) & "@#@" & I
            Dic.Remove Key:   Dic.Add Key, Item
        End If
    Next I
    For Each v In Dic.Keys()
        aTmp = Dic.Item(v)
        For J = 1 To C
            For Each Idx In Split(aTmp, "@#@")
                K = K + 1
                dArr(K, 1) = sArr(CLng(Idx), J)
            Next
        Next J
    Next v
    Range("E2").Resize(K) = dArr
Else
    MsgBox "Du lieu qua lon"
End If
End Sub

Hổm nay chu du nơi nào mà vui quá quên luôn diễn đàn

Théc mét một chút, sao lại Remove Key rồi lại Add Key, mà cặp mắt kính "@#@" hơi quá khổ

♫ђöล♥ßล†♥†µ♫ · 13/10/18

HieuCD đã viết:
Hổm nay chu du nơi nào mà vui quá quên luôn diễn đàn
Théc mét một chút, sao lại Remove Key rồi lại Add Key, mà cặp mắt kính "@#@" hơi quá khổ

Dạ mấy hôm nay bận quá Anh ạ. Em nghĩ là xóa cái cũ thay bằng cái mới ạ

HieuCD · 13/10/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Dạ mấy hôm nay bận quá Anh ạ. Em nghĩ là xóa cái cũ thay bằng cái mới ạ

Key vẫn vậy, chỉ thay item thì: Item(key) =Item(key) &... & ....

♫ђöล♥ßล†♥†µ♫ · 13/10/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Dạ mấy hôm nay bận quá Anh ạ. Em nghĩ là xóa cái cũ thay bằng cái mới ạ

Đúng là em Chữ Thầy trả Thầy rồi Anh nhỉ
Có phải như thế này không anh

Mã:

Dic.Item(Key) = Dic.Item(Key) & "@#@" & I

winnies · 22/10/18

Cám ơn cả nhà đã giúp đỡ nhiệt tình

Trong trường hợp nếu mình muốn sắp sếp 3 cột liên tiếp thì làm thế nào ah. Mong cả nhà giúp đỡ mình. Mình gửi file đính kèm

snow25 · 22/10/18

winnies đã viết:
Cám ơn cả nhà đã giúp đỡ nhiệt tình

Trong trường hợp nếu mình muốn sắp sếp 3 cột liên tiếp thì làm thế nào ah. Mong cả nhà giúp đỡ mình. Mình gửi file đính kèm

đây em

winnies · 22/10/18

snow25 đã viết:
đây em

Hi anh,

File anh gửi trùng file em nhờ giúp. Anh gửi lại giúp em nhé

snow25 · 22/10/18

winnies đã viết:
Hi anh,

File anh gửi trùng file em nhờ giúp. Anh gửi lại giúp em nhé

đây cái kia là có code rồi em ko nhìn thấy thôi

winnies · 22/10/18

snow25 đã viết:
đây cái kia là có code rồi em ko nhìn thấy thôi

hi anh,

File này đã có nút sắp sếp. Cám ơn anh nhiều

winnies · 22/10/18

snow25 đã viết:
đây cái kia là có code rồi em ko nhìn thấy thôi

DEAR ANH,

Anh có thể giúp mình làm thành 3 sheet như file đính kèm được không. Công thức mình chưa hiểu lắm nên ko biết cách làm. Mong anh giúp

Insert Collume

Thành viên mới

Thành viên gạo cội

Thành viên mới

File đính kèm

Thành viên gạo cội

File đính kèm

Thành viên thường trực

Thành viên gạo cội

==(^o^)==

Ăn cùng góc phố

Thành viên gạo cội

Thành viên tiêu biểu

Chuyên gia GPE

Thành viên tiêu biểu

Chuyên gia GPE

Thành viên tiêu biểu

Thành viên mới

File đính kèm

Thành viên gạo cội

File đính kèm

Thành viên mới

Thành viên gạo cội

File đính kèm

Thành viên mới

Thành viên mới

File đính kèm

Đếm ngược thời gian