Viết giúp mình macro copy dữ liệu theo điều kiện sang trang tính khác (1 người xem)

[SA_DQ]

Bảng dữ liệu của mình cô gọn lại như dưới đây:

| B | C 1 | O |GPE
2 | Em |
3 |Anh|
4 | Em |
5 | Em |
6 ||
7 | O |GPE.COM
8 | Em |
9 |Cô|
10 | Em |
11 |Bà|
12 | O |XYZ
13 |...|...

Nhiệm vụ mà mình cần giúp sẽ như sau:

#1: Tạo vòng lặp duyệt theo cột để đếm số 'Em' giữa 2 giá trị 'O' từ trên xuống;
Khi gặp 'O' thứ 2 thì chép trị ở ô bên fải của 'O' thứ nhất ('GPE') sang cột 'B' trang tính bên cạnh với số lần bằng với số 'Em' đã gặp trong vùng (3)

Khi gặp 'O' kế tiếp (hàng 12), thì chép 'GPE.COM' nối tiếp vô fía dưới của cột 'B' trang tính bên cạnh với số lần 'Em' vừa gặp (2)

Xin cảm ơn các bạn đã quan tâm.

 

[thanhlanh]

Chẳng biết là cao thủ nhờ hay đố nữa nhưng cứ giait thử có gì còn học hỏi:

Option Base 1
Sub Dem()
    Dim arrDulieu(), arrKQ(), tem, d, i
    With Sheets("Sheet1")
        arrDulieu = .Range(.[B1], .[B65536].End(xlUp)).Resize(, 2).Value
    End With
    For d = 1 To UBound(arrDulieu, 1)
        If arrDulieu(d, 1) = "O" Then
            tem = arrDulieu(d, 2)
        End If
        If arrDulieu(d, 1) = "Em" Then
            i = i + 1
            ReDim Preserve arrKQ(i): arrKQ(i) = tem
        End If
    Next
    Sheets("Sheet2").Range("B65536").End(xlUp).Offset(1).Resize(i) = WorksheetFunction.Transpose(arrKQ)
End Sub

 

[Ba Tê]

Bảng dữ liệu của mình cô gọn lại như dưới đây:

| B | C 1 | O |GPE
2 | Em |
3 |Anh|
4 | Em |
5 | Em |
6 ||
7 | O |GPE.COM
8 | Em |
9 |Cô|
10 | Em |
11 |Bà|
12 | O |XYZ
13 |...|...

Nhiệm vụ mà mình cần giúp sẽ như sau:

#1: Tạo vòng lặp duyệt theo cột để đếm số 'Em' giữa 2 giá trị 'O' từ trên xuống;
Khi gặp 'O' thứ 2 thì chép trị ở ô bên fải của 'O' thứ nhất ('GPE') sang cột 'B' trang tính bên cạnh với số lần bằng với số 'Em' đã gặp trong vùng (3)

Khi gặp 'O' kế tiếp (hàng 12), thì chép 'GPE.COM' nối tiếp vô fía dưới của cột 'B' trang tính bên cạnh với số lần 'Em' vừa gặp (2)

Xin cảm ơn các bạn đã quan tâm.

"Lão ni" thất nghiệp rồi "chọc ghẹo" đây mà.
"Mại dzô"!
---------------
MÌnh cũng thất nghiệp, "thọt lét" lão một cái cho lão cười chơi:

Public Sub GPE()
Dim Rng(), Arr(), i As Long, K As Long, KQ As Long, DK As String, tem As String
DK = "O": tem = "Em"
With Sheet1
    Rng = .Range(.[A1], .[A65000].End(xlUp)).Value
End With
ReDim Arr(1 To UBound(Rng, 1), 1 To 1)
    For i = 1 To UBound(Rng, 1)
        If Rng(i, 1) = DK Then
            K = K + 1
            If K > 1 Then
                Arr(K - 1, 1) = KQ
                KQ = 0
            End If
        ElseIf Rng(i, 1) = tem Then
            KQ = KQ + 1
        End If
    Next i
If K Then Sheet2.[A1].Resize(K).Value = Arr
End Sub

 

[ChanhTQ@]

#2: Leveling Macro

Guys i find it hard to do this is macro.im a newbie in vb.
anyone can help.
below is my sampe datasheet.Col.A & B.

A | B
1| A
2| A1
2| A2
3| A2.1
2| A3
3| A3.1
1| B
2| B1
2| B2
3| B2.1
2| B3

i want to result like below format in Col.D & E.

D | E
A |A1
A| A2
A2| A2.1
A |A3
A3| A3.1
B| B1
B| B2
B2| B2.1
B| B3

//* note
* 1 is the parent node of 2
* 2 is the parent node of 3
* 3 is the parent node of 4
and so on...

Appreciate your help.
Regards,

 

[Ba Tê]

Guys i find it hard to do this is macro.im a newbie in vb.
anyone can help.
below is my sampe datasheet.Col.A & B.

A | B
1| A
2| A1
2| A2
3| A2.1
2| A3
3| A3.1
1| B
2| B1
2| B2
3| B2.1
2| B3

i want to result like below format in Col.D & E.

D | E
A |A1
A| A2
A2| A2.1
A |A3
A3| A3.1
B| B1
B| B2
B2| B2.1
B| B3

//* note
* 1 is the parent node of 2
* 2 is the parent node of 3
* 3 is the parent node of 4
and so on...

Appreciate your help.
Regards,

This question is difficult to answer.

 

[dhn46]

Cháu làm thế này không biết có đúng ý chú không?

Sub Button1_Click()
Dim Arr, sArr
Arr = Sheet1.[a2:b12]
ReDim sArr(1 To UBound(Arr, 1) + 1, 1 To 2)
Dim i, j, k As Integer


For i = 1 To UBound(Arr, 1)
    For j = 1 To UBound(Arr, 1)
        If Len(Arr(j, 2)) = 1 Then Arr(j, 2) = ""
        If Arr(j, 2) >= Arr(i, 2) Then
            Max = Arr(j, 2)
            Arr(j, 2) = Arr(i, 2)
            Arr(i, 2) = Max
        End If
    Next
Next


For i = 1 To UBound(Arr, 1)
    If Arr(i, 2) <> "" Then
        k = k + 1
        sArr(k, 2) = Arr(i, 2)
        sArr(k, 1) = Left(sArr(k, 2), 1) & Int(Val(Right(sArr(k, 2), Len(sArr(k, 2)) - 1)))
    End If
Next


Sheet2.[A1].Resize(UBound(sArr, 1), UBound(sArr, 2)) = sArr
End Sub

 

[ChanhTQ@]

Giải thuật của DHN46;449726 f ức tạp quá & cũng chưa theo iêu cầu

Làm thế này không biết có đúng ý không?
. . . . code

Theo mình giải thuật thể hiện ở bảng dưới đây:

|Vòng lăp duyệt theo cột 'A'|. . |Cột 'D'|Cột 'E'
(Dòng|Nếu gặp số 1||Không ghi|Không ghi
đang|Nếu gặp số 2 ||Left([Bi], 1 )|[Bi]
là i)|Nếu gặp số 3 ||Left([Bi], 2 )|[Bi]
|. . . ||..|...

 

[Ba Tê]

Theo mình giải thuật thể hiện ở bảng dưới đây:

|Vòng lăp duyệt theo cột 'A'|. . |Cột 'D'|Cột 'E'
(Dòng|Nếu gặp số 1||Không ghi|Không ghi
đang|Nếu gặp số 2 ||Left([Bi], 1 )|[Bi]
là i)|Nếu gặp số 3 ||Left([Bi], 2 )|[Bi]
|. . . ||..|...

Nếu không có gợi ý chắc "đui con mắt bên trái, mù con mắt bên phải" với cái 1,2,3,A,B,C này quá.

Public Sub LuXuBu()
Dim Rng(), Arr(), I As Long, K As Long
Rng = Range([A1], [B65000].End(xlUp)).Value
ReDim Arr(1 To UBound(Rng, 1), 1 To 2)
For I = 1 To UBound(Rng, 1)
    If Rng(I, 1) > 1 Then
        K = K + 1
        Arr(K, 1) = Left(Rng(I, 2), Rng(I, 1) - 1)
        Arr(K, 2) = Rng(I, 2)
    End If
Next
[C1].Resize(K, 2).Value = Arr
End Sub