[Help] VBA copy nối cột các Data có dạng .jpg

Liên hệ QC

robinhsoon

Thành viên hoạt động
Tham gia
19/1/16
Bài viết
153
Được thích
11
Thân chào cả nhà GPE!

Mong cả nhà giúp em giải bài toán này ạ.
Hiện tại em có 01 File data gồm 02 Sheet data và Kết Quả:
Từ Sheet Data em muốn copy các Cell nào có dạng .jpg nối cột qua Sheet Kết Quả.
Sheet Kết Quả em có làm mẫu ạ.

Mong Cả nhà giúp đỡ, em chân thành cảm ơn.
 

File đính kèm

Thân chào cả nhà GPE!

Mong cả nhà giúp em giải bài toán này ạ.
Hiện tại em có 01 File data gồm 02 Sheet data và Kết Quả:
Từ Sheet Data em muốn copy các Cell nào có dạng .jpg nối cột qua Sheet Kết Quả.
Sheet Kết Quả em có làm mẫu ạ.

Mong Cả nhà giúp đỡ, em chân thành cảm ơn.

Dùng JoinText của anh NDU xong xóa những cột không cần thiết đi.
 
Upvote 0
Sai nha! Bài này không phải là nối chuỗi

Em nối lại xong em lọc ra cột nào có 10764* thì giữ lại, còn lại xóa đi, em không biết gì về VBA, chỉ là dùng cái của anh áp dụng sau đó xóa cái thừa đi. em làm thử file đó vẫn cho ra 189 dòng như chủ thớt làm sẵn.
 
Upvote 0
Em nối lại xong em lọc ra cột nào có 10764* thì giữ lại, còn lại xóa đi, em không biết gì về VBA, chỉ là dùng cái của anh áp dụng sau đó xóa cái thừa đi. em làm thử file đó vẫn cho ra 189 dòng như chủ thớt làm sẵn.
Cảm ơn Anh đã quan tâm ạ.. Vì số 10764* có thể thay đổi theo số lượng data nên không dùng cách đó được ạ.. Mong muốn của em là copy ra các Cell có dạng *.jpg ạ
 
Upvote 0
Cảm ơn Anh đã quan tâm ạ.. Vì số 10764* có thể thay đổi theo số lượng data nên không dùng cách đó được ạ.. Mong muốn của em là copy ra các Cell có dạng *.jpg ạ

Chắn chắn làm được mà, không lọc 10764* thì *.jpg vẫn ra thôi.
 
Upvote 0
Cảm ơn Anh đã quan tâm ạ.. Vì số 10764* có thể thay đổi theo số lượng data nên không dùng cách đó được ạ.. Mong muốn của em là copy ra các Cell có dạng *.jpg ạ
Code "*jpg" đây:
PHP:
Public Sub s_Gpe()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, Col As Long
sArr = Sheets("Data").Range("A1").CurrentRegion.Value
R = UBound(sArr)
Col = UBound(sArr, 2)
ReDim dArr(1 To R * Col, 1 To 1)
For J = 1 To Col
    For I = 2 To R
        If sArr(I, J) <> Empty Then
            If sArr(I, J) Like "*jpg" Then
                K = K + 1
                dArr(K, 1) = sArr(I, J)
            End If
        End If
    Next I
Next J
Sheets("KetQua").Range("B2").Resize(K) = dArr
End Sub
 
Upvote 0
Thân chào cả nhà GPE!

Mong cả nhà giúp em giải bài toán này ạ.
Hiện tại em có 01 File data gồm 02 Sheet data và Kết Quả:
Từ Sheet Data em muốn copy các Cell nào có dạng .jpg nối cột qua Sheet Kết Quả.
Sheet Kết Quả em có làm mẫu ạ.

Mong Cả nhà giúp đỡ, em chân thành cảm ơn.
Code vầy xem sao:
Mã:
Sub Test()
  Dim aSource, item
  Dim lR As Long
  aSource = Sheets("Data").UsedRange.Value
  If IsArray(aSource) Then
    ReDim aDes(1 To UBound(aSource, 1) * UBound(aSource, 2), 1 To 1)
    For Each item In aSource
      If UCase(Right(item, 4)) = ".JPG" Then
        lR = lR + 1
        aDes(lR, 1) = item
      End If
    Next
    If lR Then Sheets("KetQua").Range("A2").Resize(lR).Value = aDes
  End If
End Sub
 
Upvote 0
Em cảm ơn cả nhà đã giúp đỡ em ạ.. Em đã làm được rồi ạ..

Chúc cả nhà sức khỏe và thành công
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom