Xác định vùng copy dựa vào dữ liệu ô (1 người xem)

[hadoan-pap]

Em chào mọi người.

Em có bài toán như file đính kèm ạ.

Em muốn xác định để copy các vùng dữ lieu từ Sheet1 sang Sheet2 ( bôi vàng ) như trong file.

Ví dụ như trong file thì em sẽ copy khoảng dữ lieu từ B:C dựa vào cột "Type" ... Vì các dòng là không cố định, nên không thể xác định được khoảng range cụ thể để copy ạ... mà em muốn dựa vào cột Type để xác định khoảng cần copy.

Ví dụ: Nếu ô đầu tiên là "tool", nó sẽ chạy tiếp đến dòng mà có text khác chữ "tool" thì nó sẽ copy range từ ô đầu tiên đến vị trí cuối cùng có dòng text khác đó trừ đi 1.

Em xin cảm ơn!

 

[ppc0312]

Em chào mọi người.

Em có bài toán như file đính kèm ạ.

Em muốn xác định để copy các vùng dữ lieu từ Sheet1 sang Sheet2 ( bôi vàng ) như trong file.

Ví dụ như trong file thì em sẽ copy khoảng dữ lieu từ B:C dựa vào cột "Type" ... Vì các dòng là không cố định, nên không thể xác định được khoảng range cụ thể để copy ạ... mà em muốn dựa vào cột Type để xác định khoảng cần copy.

Ví dụ: Nếu ô đầu tiên là "tool", nó sẽ chạy tiếp đến dòng mà có text khác chữ "tool" thì nó sẽ copy range từ ô đầu tiên đến vị trí cuối cùng có dòng text khác đó trừ đi 1.

Em xin cảm ơn!

Có thấy code gì trong file đâu
ngoài sub và end sub
Thử làm theo ý bạn sao, thì hỏi
Tìm hiểu Range.End cũng được

 

[hadoan-pap]

Có thấy code gì trong file đâu
ngoài sub và end sub
Thử làm theo ý bạn sao, thì hỏi
Tìm hiểu Range.End cũng được

Dạ, trong file không có code vì em đang nhờ mọi ng support đoạn code đó ạ ^^

 

[ppc0312]

Dạ, trong file không có code vì em đang nhờ mọi ng support đoạn code đó ạ ^^

Tự làm đi mới tiến được, Sai hay mắc đâu hỏi tiếp.
Gợi ý là sử dụng phương thức End của range đó (Range.End) - vì đặc trưng dữ liệu như file kèm

 

[hadoan-pap]

Tự làm đi mới tiến được, Sai hay mắc đâu hỏi tiếp.
Gợi ý là sử dụng phương thức End của range đó (Range.End) - vì đặc trưng dữ liệu như file kèm

Cái khó em đang gặp phải là làm sao xác định được vùng để copy như em có trình bày ở trên. E cũng vẫn đang tìm cách làm nhưng chưa được.

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

Đây là đoạn code e viết... nhưng đang mắc ở chỗ làm sao xác định đc range để copy.

Mọi người kiểm tra giúp em với ạ.

Dim rcnt, rcnt1 As Long
rcnt = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To rcnt
For i1 = 1 To rcnt
If Range("A" & i).Value = "tool" Then
If Range("A" & i1).Value <> "tool" Then

'' xác định range để copy
Sheet2.Range("B3").PasteSpecial xlPasteAll

End If
End If
Next i1
Next i

Application.CutCopyMode = False

 

[Ba Tê]

Cái khó em đang gặp phải là làm sao xác định được vùng để copy như em có trình bày ở trên. E cũng vẫn đang tìm cách làm nhưng chưa được.

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

Đây là đoạn code e viết... nhưng đang mắc ở chỗ làm sao xác định đc range để copy.

Mọi người kiểm tra giúp em với ạ.

Dim rcnt, rcnt1 As Long
rcnt = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To rcnt
For i1 = 1 To rcnt
If Range("A" & i).Value = "tool" Then
If Range("A" & i1).Value <> "tool" Then

'' xác định range để copy
Sheet2.Range("B3").PasteSpecial xlPasteAll

End If
End If
Next i1
Next i

Application.CutCopyMode = False

Bạn tạo dữ liệu "làm khó" cho chính mình.
Thêm cột phụ D, D2=LOOKUP("zzz";$A$2:A2), Copy xuống.
Lúc đó, dùng Filter hay muốn viết code kiểu gì cũng dễ.

 

[hadoan-pap]

Bạn tạo dữ liệu "làm khó" cho chính mình.
Thêm cột phụ D, D2=LOOKUP("zzz";$A$2:A2), Copy xuống.
Lúc đó, dùng Filter hay muốn viết code kiểu gì cũng dễ.

Gửi anh.

Dạ phần này chắc em sẽ tự tìm cách để sửa lại cho dễ hơn ạ.

Trong file em muốn gán Mã Code vào các ô I1,I4,I5,I7 theo các giá trị giảm dần dựa vào cột Quantity.... Anh giúp em đoạn code này được không ạ ?

Em cảm ơn anh!

 

[Ba Tê]

Gửi anh.

Dạ phần này chắc em sẽ tự tìm cách để sửa lại cho dễ hơn ạ.

Trong file em muốn gán Mã Code vào các ô I1,I4,I5,I7 theo các giá trị giảm dần dựa vào cột Quantity.... Anh giúp em đoạn code này được không ạ ?

Em cảm ơn anh!

Vừa xem bài #1 lại thay đổi bằng bài #7.
Code cho #1:

Option Explicit

Public Sub s_Gpe()
Dim sArr(), dArr(), I As Long, R As Long, K As Long, CoL As Long, Rws As Long, MaxR As Long, Tmp As Variant
    sArr = Sheet1.Range("A2", Sheet1.Range("C10000").End(xlUp)).Value
    R = UBound(sArr)
    CoL = -3
ReDim dArr(1 To R, 1 To R*4)
For I = 1 To R
    If sArr(I, 1) <> Empty Then
        CoL = CoL + 4
        K = 1
        dArr(K, CoL) = sArr(I, 2)
        dArr(K, CoL + 1) = sArr(I, 3)
       If K > MaxR Then MaxR = K
    Else
        K = K + 1
        dArr(K, CoL) = sArr(I, 2)
        dArr(K, CoL + 1) = sArr(I, 3)
        If K > MaxR Then MaxR = K
    End If
Next I
    Sheet2.Range("B3").Resize(MaxR, CoL + 1) = dArr
End Sub

 

[hadoan-pap]

Vừa xem bài #1 lại thay đổi bằng bài #7.
Code cho #1:

Option Explicit

Public Sub s_Gpe()
Dim sArr(), dArr(), I As Long, R As Long, K As Long, CoL As Long, Rws As Long, MaxR As Long, Tmp As Variant
    sArr = Sheet1.Range("A2", Sheet1.Range("C10000").End(xlUp)).Value
    R = UBound(sArr)
    CoL = -3
ReDim dArr(1 To R, 1 To R*4)
For I = 1 To R
    If sArr(I, 1) <> Empty Then
        CoL = CoL + 4
        K = 1
        dArr(K, CoL) = sArr(I, 2)
        dArr(K, CoL + 1) = sArr(I, 3)
       If K > MaxR Then MaxR = K
    Else
        K = K + 1
        dArr(K, CoL) = sArr(I, 2)
        dArr(K, CoL + 1) = sArr(I, 3)
        If K > MaxR Then MaxR = K
    End If
Next I
    Sheet2.Range("B3").Resize(MaxR, CoL + 1) = dArr
End Sub

Gửi anh @Ba Tê

+) Với bài toán 1: E cảm ơn anh rất nhiều ạ... e có chạy nhưng nó lỗi như ảnh em gửi. Đây sẽ là đoạn code rất hữu ích cho em học và áp dung vào bài toán thực tế của em ạ. Trong file đính kèm là nut "Go1"

+) Với bài toán 2: Em đã làm đoạn code như bên dưới... đã tìm được giá trí lớn nhất trong mảng sau đó gán giá trị tương ứng mình muốn vào cell.... Tuy nhiên em đang mắc ở chỗ là làm thế nào để tìm được giá trị lớn nhất tiếp theo trong các giá trị còn lại đó ạ.

Dim Rng As Range
Dim MaxCell As Range
Dim MaxVal As Long

Set Rng = Range("C2:C10")
MaxVal = WorksheetFunction.Max(Rng)

' use the Find function to get the Row number
Set MaxCell = Rng.Find(what:=MaxVal, LookIn:=xlValues)

''MsgBox "Maximum value found at row " & MaxCell.Column

Sheet1.Cells(1, 9) = Sheet1.Cells(MaxCell.Row, MaxCell.Column - 1)

 

[Ba Tê]

Gửi anh @Ba Tê

+) Với bài toán 1: E cảm ơn anh rất nhiều ạ... e có chạy nhưng nó lỗi như ảnh em gửi. Đây sẽ là đoạn code rất hữu ích cho em học và áp dung vào bài toán thực tế của em ạ. Trong file đính kèm là nut "Go1"

+) Với bài toán 2: Em đã làm đoạn code như bên dưới... đã tìm được giá trí lớn nhất trong mảng sau đó gán giá trị tương ứng mình muốn vào cell.... Tuy nhiên em đang mắc ở chỗ là làm thế nào để tìm được giá trị lớn nhất tiếp theo trong các giá trị còn lại đó ạ.

Dim Rng As Range
Dim MaxCell As Range
Dim MaxVal As Long

Set Rng = Range("C2:C10")
MaxVal = WorksheetFunction.Max(Rng)

' use the Find function to get the Row number
Set MaxCell = Rng.Find(what:=MaxVal, LookIn:=xlValues)

''MsgBox "Maximum value found at row " & MaxCell.Column

Sheet1.Cells(1, 9) = Sheet1.Cells(MaxCell.Row, MaxCell.Column - 1)

File Bài #1 tôi đã chỉnh Code trên bài #8, bạn xem lại. Bạn lấy code bài #1 chạy cho dữ liệu bài #7 sao được? Bạn phải chạy Code cho bài #1 rồi kiểm tra kết quả.
Bài #2, bạn muốn gì thì đưa dữ liệu giống thật và kết quả giống thật lên. Bạn viết code rồi bảo người khác đọc làm sao mà hiểu!

 

[hadoan-pap]

File Bài #1 tôi đã chỉnh Code trên bài #8, bạn xem lại. Bạn lấy code bài #1 chạy cho dữ liệu bài #7 sao được? Bạn phải chạy Code cho bài #1 rồi kiểm tra kết quả.
Bài #2, bạn muốn gì thì đưa dữ liệu giống thật và kết quả giống thật lên. Bạn viết code rồi bảo người khác đọc làm sao mà hiểu!

Gửi anh.

Dạ như file đính kèm e có bôi vàng mấy ô I1, I4,I5,I8 đấy ạ.... sau khi ấn nút "Sort" thì nó sẽ tìm lần lượt các mã code có quantity từ cao đến thấp và gán vào 4 ô có bôi vàng ạ.

 

[hadoan-pap]

File Bài #1 tôi đã chỉnh Code trên bài #8, bạn xem lại. Bạn lấy code bài #1 chạy cho dữ liệu bài #7 sao được? Bạn phải chạy Code cho bài #1 rồi kiểm tra kết quả.
Bài #2, bạn muốn gì thì đưa dữ liệu giống thật và kết quả giống thật lên. Bạn viết code rồi bảo người khác đọc làm sao mà hiểu!

Gửi anh @Ba Tê

Dạ e cảm ơn anh rất nhiều.

Em đã làm được bài toán số 2 rồi ạ.

Cảm ơn anh rất nhiều cho bài toán số 1... em sẽ học hỏi them ạ.

Một lần nữa cảm ơn anh và chúc anh buổi tối vui vẻ ^^

Dim rng As Range, cell As Range
Dim first As Double, second As Double, third As Double, fourth As Double

Set rng = [C2:C16]


first = Application.WorksheetFunction.Large(rng, 1)
second = Application.WorksheetFunction.Large(rng, 2)
third = Application.WorksheetFunction.Large(rng, 3)
fourth = Application.WorksheetFunction.Large(rng, 4)

For I = 2 To 100

If Sheet1.Cells(I, 3) = first Then

Sheet1.Cells(1, 9) = Sheet1.Cells(I, 2)

ElseIf Sheet1.Cells(I, 3) = second Then

Sheet1.Cells(4, 9) = Sheet1.Cells(I, 2)

ElseIf Sheet1.Cells(I, 3) = third Then

Sheet1.Cells(5, 9) = Sheet1.Cells(I, 2)

ElseIf Sheet1.Cells(I, 3) = fourth Then

Sheet1.Cells(7, 9) = Sheet1.Cells(I, 2)

End If

Next I