Vòng lặp như thế nào đây!

[MinhK]

Xem file Book1.2.Xls
Sheet1 và Sheet2 đã đươc post trong 1 chũ đề khác, tuy nhiên chưa đũ may mắn.
Lần này I'm feel lucky cho nên lại post thêm :
Sheet3 là gốc làm viêc cho Sheet 4, câu hỏi là:
Làm thế nào copy những ID giông nhau và sau đó (cột B,C,E,F) trên 1 hàng thanh ra 1 hàng duy nhất.
Ví dụ:
Sheet3 từ row2 --> row11
ID2 0.4601 0.5399 0.5634 0.4366
ID2 0.5117 0.4883 0.6009 0.3991
ID2 0.3991 0.6009 0.3850 0.6150
ID2 0.5305 0.4695 0.5493 0.4507
ID2 0.5023 0.4977 0.5775 0.4225
ID2 0.4930 0.5070 0.5587 0.4413
ID2 0.5164 0.4836 0.5869 0.4131
ID2 0.5258 0.4742 0.5915 0.4085
ID2 0.5352 0.4648 0.5164 0.4836
ID2 0.4601 0.5399 0.5822 0.4178
Được chuyển sang Sheet4
ID2 0.4601 0.5399 0.5634 0.4366 ID2 0.5117 0.4883 0.6009 0.3991 ID2 0.3991 0.6009 0.3850 0.6150 .....
Cũng như lần trước tôi cũng đã viết dưới dạng WBT, vì muốn chuyển sỡ học WBT sang VBA , mong các bác giúp đỡ.
Thành thật cám ơn cac bác.
chú ý : Mỗi ID có 10 hàng
Linh mới to te VBA/VBE,

 

[Mr Okebab]

Xem file Book1.2.Xls
Sheet1 và Sheet2 đã đươc post trong 1 chũ đề khác, tuy nhiên chưa đũ may mắn.
Lần này I'm feel lucky cho nên lại post thêm :
Sheet3 là gốc làm viêc cho Sheet 4, câu hỏi là:
Làm thế nào copy những ID giông nhau và sau đó (cột B,C,E,F) trên 1 hàng thanh ra 1 hàng duy nhất.
Ví dụ:
Sheet3 từ row2 --> row11
ID2 0.4601 0.5399 0.5634 0.4366
ID2 0.5117 0.4883 0.6009 0.3991
ID2 0.3991 0.6009 0.3850 0.6150
ID2 0.5305 0.4695 0.5493 0.4507
ID2 0.5023 0.4977 0.5775 0.4225
ID2 0.4930 0.5070 0.5587 0.4413
ID2 0.5164 0.4836 0.5869 0.4131
ID2 0.5258 0.4742 0.5915 0.4085
ID2 0.5352 0.4648 0.5164 0.4836
ID2 0.4601 0.5399 0.5822 0.4178
Được chuyển sang Sheet4
ID2 0.4601 0.5399 0.5634 0.4366 ID2 0.5117 0.4883 0.6009 0.3991 ID2 0.3991 0.6009 0.3850 0.6150 .....
Cũng như lần trước tôi cũng đã viết dưới dạng WBT, vì muốn chuyển sỡ học WBT sang VBA , mong các bác giúp đỡ.
Thành thật cám ơn cac bác.
chú ý : Mỗi ID có 10 hàng
Linh mới to te VBA/VBE,

Bạn thử xem nhé :

Sub OB()
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    Dim HC As Long, i As Long, iC As Integer, iR As Long
    With S05
        For i = 2 To S03.Range("B65000").End(xlUp).Row
            HC = .Range("A65000").End(xlUp).Row
            iR = TimRow(S03.Range("B" & i), .Range("A1:A" & HC))
            
            If iR = 0 Then
                HC = HC + 1
                .Range("A" & HC & ":E" & HC).Value = S03.Range("B" & i & ":F" & i).Value
            Else
                iC = .Range("A" & iR).End(xlToRight).Column + 1
                If iC < 252 Then _
                    .Range(Cells(iR, iC), Cells(iR, iC + 3)).Value = S03.Range("C" & i & ":F" & i).Value
            End If
        Next
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Function TimRow(Ma As String, Mang As Range) As Long
    On Error Resume Next
    TimRow = WorksheetFunction.Match(Ma, Mang, 0)
End Function

Thân!

 

[MinhK]

Chào anh MR Okebab
Quả nhiên I'm feel lucky, thật tuyệt quá rồi chĩ thiếu 1 chút mà tôi không biết sửa như thế nào:

ID2 0.4601 0.5399 0.5634 0.4366 ID2 0.5117 0.4883 0.6009 0.3991 ID2 0.3991 0.6009 0.3850 0.6150 ID2....

Cột Key ??

với lại data của tôi lên tới nhiều chục ngàn ID thì phài làm sao ?

Cám ôn anh MR OB

 

[MinhK]

To anh Mr OB
tôi chỉnh lại:
If iC < 252 Then _
.Range(Cells(iR, iC), Cells(iR, iC + 4)).Value = S03.Range("B" & i & ":F"& i).Value
thì có IDx trên 1 hàng, nhưng không biết chình để bắt đâu từ cột ID (B:B)(KHông từ cột A:A , rồi thì có thê đánh số thứ tự cho cột KEY (A:A) ?
Anh nghỉ sao?
MK

 

[Mr Okebab]

Chào anh MR Okebab
Quả nhiên I'm feel lucky, thật tuyệt quá rồi chĩ thiếu 1 chút mà tôi không biết sửa như thế nào:

ID2 0.4601 0.5399 0.5634 0.4366 ID2 0.5117 0.4883 0.6009 0.3991 ID2 0.3991 0.6009 0.3850 0.6150 ID2....

Cột Key ??

với lại data của tôi lên tới nhiều chục ngàn ID thì phài làm sao ?

Cám ôn anh MR OB

If iC < 252 Then _
.Range(Cells(iR, iC), Cells(iR, iC + 4)).Value = S03.Range("B" & i & ":F"& i).Value
thì có IDx trên 1 hàng, nhưng không biết chình để bắt đâu từ cột ID (B:B)(KHông từ cột A:A , rồi thì có thê đánh số thứ tự cho cột KEY (A:A) ?
Anh nghỉ sao?
MK

Sửa lại một chút thôi :

Sub OB()
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    Dim HC As Long, i As Long, iC As Integer, iR As Long
    With S05
        ' Xoa du lieu cu
        .Range("A2:IV50000").ClearContents
        
        For i = 2 To S03.Range("B65000").End(xlUp).Row
            HC = .Range("B65000").End(xlUp).Row
            iR = TimRow(S03.Range("B" & i), .Range("B1:B" & HC))
            
            If iR = 0 Then
                HC = HC + 1
                .Range("B" & HC & ":F" & HC).Value = S03.Range("B" & i & ":F" & i).Value
            Else
                iC = .Range("B" & iR).End(xlToRight).Column + 1
                If iC < 251 Then _
                    .Range(Cells(iR, iC), Cells(iR, iC + 4)).Value = S03.Range("B" & i & ":F" & i).Value
            End If
        Next
        ' Danh lai STT
        With .Range("A2:A" & .Range("B65000").End(xlUp).Row)
            .FormulaR1C1 = "=Row()-1"
            .Calculate
            .Value = .Value
        End With
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Function TimRow(Ma As String, Mang As Range) As Long
    On Error Resume Next
    TimRow = WorksheetFunction.Match(Ma, Mang, 0)
End Function

Việc có hàng ngàn ID thì cũng chẳng có vấn đề gì, bạn cú thử thêm vào sẽ thấy.
Tuy nhiên điều quan trọng là môt ID chỉ có tối đa là 51 hàng thôi (ở bên Sheet nguồn), vì nó sẽ chuyển thành cột ở bên TONGHOP, mà số cột trong 1 sheet tối đa chỉ là 255 thôi.

Nếu nhiều hơn 51 thì lại phải có thêm chút tiểu xảo nữa. Bạn tự nghiên cứu nhé.

Thân!

 

[MinhK]

Chào anh MR OB
Thật hoàn chỉnh và gọn nhẹ. và nhanh hơn hẳn lối viết WBT.
Tôi viết sai ý của mình, vì muốn hỏi về update thì fải làm sao mà viết là nhiều ID,
và Một ngày mới bắt đầu bằng ÁNH MẮT - NỤ CƯỜI
MK

 

[ndu96081631]

Bài toán này có thể làm bằng công thức thường
Này nhé:
1> Đặt con trỏ chuột tại cell B2 của Sheet4
2> Vào Define name và thiết lập công thức:

Loc =OFFSET($B$2,(ROWS($1:1)-1)*10+INT((COLUMNS($A:A)-1)/5),MOD(COLUMNS($A:A)-1,5))

3> Ở cell B2 của sheet 4 gõ vào công thức
=Loc
4> Kéo fill đi toàn bộ các cell
Vậy là xong!
Xem file đính kèm

 

[MinhK]

Chào anh ndu9608161
Tôi đã vào inert/Name/Define , doubleclick "Loc", rối Cell B2 như anh chỉ nhưng chưa đươc,
Mog anh chỉ lại cach define name lai cho .
Thanhks

 

[ndu96081631]

Chào anh ndu9608161
Tôi đã vào inert/Name/Define , doubleclick "Loc", rối Cell B2 như anh chỉ nhưng chưa đươc,
Mog anh chỉ lại cach define name lai cho .
Thanhks

Do name này có liên quan đến ActiveCell bên sheet 4 (tức nó sẽ biến đổi dựa vào vị trí cell ở sheet 4 đang nằm ở nào)
Giờ bạn mở file đính kèm, đặt con trỏ vào cell B2 tại sheet 4 (nhớ là sheet 4 nha). Sau đó vào Define name sẽ thấy công thức...
Nếu bạn đặt con trỏ chuột sang 1 cell khác rồi vào Define name thì sẽ thấy công thức thay đổi (thay đổi ở chổ ROWS và COLUMNS ấy)
--------------
Bạn xác nhận dùm tôi xem file đính kèm ấy cho kết quả đúng không?

 

[MinhK]

Got milk
Cảm ơn anh NDU96081631
Đươc học thêm 1 cách hay. và tiện cho viêc update khi cần.