Nhờ giúp dùm code lọc và ghép số HĐ (1 người xem)

[hhoang_56]

Yêu cầu cụ thể có ghi trong file.
Mong mọi người giúp dùm

 

[khuongvietphong]

Bạn coi File này đúng ý không

 

[hungpecc1]

Yêu cầu cụ thể có ghi trong file.
Mong mọi người giúp dùm

code chỉ đơn giản và chân phương như vậy thôi:

Sub Button1_Click()
Dim tmparr, i&, Arr
    ReDim Arr(1 To 1)
    tmparr = Range("A2", [A65536].End(3)).Resize(, 2)
    For i = 1 To UBound(tmparr, 1)
        tmp = tmparr(i, 2)
        If tmp Like "x" Then
            n = n + 1
            ReDim Preserve Arr(1 To n)
            Arr(n) = tmparr(i, 1)
        End If
    Next
    If n Then Range("I7") = Join(Arr, " ")
End Sub

 

[hhoang_56]

Bạn coi File này đúng ý không

Hàm không tự chạy được. Phải nhập lại hàm vào cell thì mới chạy

 

[SA_DQ]

Cái ni đơn giải nè:

Option Explicit
Sub THSL()
 Dim Rng As Range, sRng As Range
 Dim MyAdd As String, sCh As String
 Dim J As Integer

 Set Rng = Range([B1], [B65500].End(xlUp))
 Set sRng = Rng.Find("x", , xlFormulas, xlWhole)
 If Not sRng Is Nothing Then
    MyAdd = sRng.Address
    Do
        J = J + 1
        sCh = sCh & " " & sRng.Offset(, -1).Value
        Set sRng = Rng.FindNext(sRng)
    Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
 End If
 If Len(sCh) Then
    [h7].Value = J:         [i7].Value = sCh
 End If
End Sub

 

[hhoang_56]

code chỉ đơn giản và chân phương như vậy thôi:

Sub Button1_Click()
Dim tmparr, i&, Arr
    ReDim Arr(1 To 1)
    tmparr = Range("A2", [A65536].End(3)).Resize(, 2)
    For i = 1 To UBound(tmparr, 1)
        tmp = tmparr(i, 2)
        If tmp Like "x" Then
            n = n + 1
            ReDim Preserve Arr(1 To n)
            Arr(n) = tmparr(i, 1)
        End If
    Next
    If n Then Range("I7") = Join(Arr, " ")
End Sub

Code chạy tốt. Cám ơn bạn

 

[be_09]

Yêu cầu cụ thể có ghi trong file.
Mong mọi người giúp dùm

Bạn nêu như thế này:

Tại cột B, có dòng có dấu x, có dòng có số tiền và có những dòng trống

Mà dựa vào dấu x thì không có khả thi (vì có chỗ là tiền, có chỗ là trống chứ không là dấu x) thì các code trên đều phá sản.

Bạn nên đưa File đang theo dõi lên (dữ liệu có thể giả định) và cụ thể hơn cái mình cần.

 

[killitmore]

Bạn nêu như thế này:


Mà dựa vào dấu x thì không có khả thi (vì có chỗ là tiền, có chỗ là trống chứ không là dấu x) thì các code trên đều phá sản.

Bạn nên đưa File đang theo dõi lên (dữ liệu có thể giả định) và cụ thể hơn cái mình cần.

Em không hiểu tại sao các code dựa vào dấu "x" lại không được ? Bác giải thích cho anh em mở mang với

 

[hungpecc1]

Em không hiểu tại sao các code dựa vào dấu "x" lại không được ? Bác giải thích cho anh em mở mang với

vì có thể điều kiện của bài toán không chỉ dừng lại ở dấu "x" , có khi là "XXX" , hay dòng trống, hay số tiền
cái này chỉ có trời biết, đất biết và bạn h_hoang56 ( chủ đề tài ) này biết thôi !

 

[Ba Tê]

Yêu cầu cụ thể có ghi trong file.
Mong mọi người giúp dùm

Đơn giản thấy "x" thì lấy, không phải "x" thì bỏ qua.

Public Sub GPE()
Dim Arr(), I As Long, Tem As String
Arr = Range("A2", Range("B65536").End(xlUp)).Value
For I = 1 To UBound(Arr)
    If UCase(Arr(I, 2)) = "X" Then Tem = Tem & Arr(I, 1) & " "
Next I
Range("I5") = Trim(Tem)
End Sub

 

[hhoang_56]

Cám ơn mọi người đã quan tâm giúp đỡ.
Mình thử các code trên thì thấy code chạy tốt, không có vấn đề gì.
Dù là số liệu trống hay khác "x" thì cũng OK.
Nhưng làm phiền mọi người thêm 1 lần nữa
Do yêu cầu của sếp nên bảng dữ liệu có thay đổi, vì vậy nhờ mọi người giúp thêm 1 lần nữa.
(Yêu cầu có ghi trong file đính kèm)

 

[khuongvietphong]

Sub vidu()
Dim i As Long,t1 as string, t2 as string
For i = 3 To 15
  If Cells(i, 2) = "x" Then
     t1 = t1 & " " & Cells(i, 1)
  End If

  If Cells(i, 4) = "x" Then
    t2 = t2 & " " & Cells(i, 3)
  End If
Next i
[I8] = t1 & " " & t2
End Sub