Copy vùng dữ liệu sang sheet khác và chỉ lấy giá trị ở giữa (1 người xem)

[tuanhuycntt]

Hiện em đang có dữ liệu trong file đính kèm. E cần lấy giữ các số ở giữa ký tự "/" và "-" nhưng em ko biết cách làm như thế nào cho hợp lý.
Các anh chị hỗ trợ giúp em với ạ.
E nghĩ là chạy = marco thì phải viết công thức lấy mid các giá trị ở cột đó rồi copy kết quả paste ở dạng value đến sheet2 rồi quay lại xóa công thức ở sheet1. Như vậy nhiều thao tác quá. Có cách nào rút gọn được không ạ

 

[hoamattroicoi]

Chào bạn,
Nếu bạn không thích dùng Mid thì bạn có thể dùng Left() kết hợp với Substitute() kiểu thế này cũng được ạ :
=LEFT(SUBSTITUTE(A2,"SIP/",""),4)

Sao bạn không đặt công thức thẳng ở ô A2 của Sheet2 nhỉ? Sao cứ phải xài Macro, dữ liệu có đến triệu dòng không bạn?

Sub Khongbietvietcode()
Dim i As Long, n As Long, m As Long
Dim sArr, dArr
sArr = Sheet1.Range("A2:A" & Sheet1.[A65536].End(xlUp).Row).Value
ReDim dArr(1 To UBound(sArr), 1 To 1)
For i = 1 To UBound(sArr)
    n = Application.WorksheetFunction.Find("/", sArr(i, 1))
    m = Application.WorksheetFunction.Find("-", sArr(i, 1))
    dArr(i, 1) = Mid(sArr(i, 1), n + 1, m - n - 1)
Next
    Sheet2.[A2].Resize(i - 1, 1) = dArr
End Sub

 

[befaint]

Application.WorksheetFunction.Find("/", sArr(i, 1))

Sao chỗ này ta không dùng hàm InStr nhỉ.

 

[hoamattroicoi]

Sao chỗ này ta không dùng hàm InStr nhỉ.

Mình đang cố miêu tả theo ý tác giả muốn mít với fai, hihihi
Bạn có thể góp vui bằng hàm InStr() befaint ạ

 

[phulien1902]

Hiện em đang có dữ liệu trong file đính kèm. E cần lấy giữ các số ở giữa ký tự "/" và "-" nhưng em ko biết cách làm như thế nào cho hợp lý.
Các anh chị hỗ trợ giúp em với ạ.
E nghĩ là chạy = marco thì phải viết công thức lấy mid các giá trị ở cột đó rồi copy kết quả paste ở dạng value đến sheet2 rồi quay lại xóa công thức ở sheet1. Như vậy nhiều thao tác quá. Có cách nào rút gọn được không ạ

Nếu bạn thích Macro:

Sub Macro1()
    Dim LR As Long, i As Long
    LR = Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    Columns(1).Copy Columns(9)
    For i = 2 To LR
        If Range("I" & i) <> Empty Then
            Range("I" & i).Replace "-", "/"
        End If
         Range("I" & i) = Split(Range("I" & i), "/")(1)
    Next i
       Application.ScreenUpdating = True
End Sub

 

[tuanhuycntt]

Chào bạn,
Nếu bạn không thích dùng Mid thì bạn có thể dùng Left() kết hợp với Substitute() kiểu thế này cũng được ạ :
=LEFT(SUBSTITUTE(A2,"SIP/",""),4)

Sao bạn không đặt công thức thẳng ở ô A2 của Sheet2 nhỉ? Sao cứ phải xài Macro, dữ liệu có đến triệu dòng không bạn?

Sub Khongbietvietcode()
Dim i As Long, n As Long, m As Long
Dim sArr, dArr
sArr = Sheet1.Range("A2:A" & Sheet1.[A65536].End(xlUp).Row).Value
ReDim dArr(1 To UBound(sArr), 1 To 1)
For i = 1 To UBound(sArr)
    n = Application.WorksheetFunction.Find("/", sArr(i, 1))
    m = Application.WorksheetFunction.Find("-", sArr(i, 1))
    dArr(i, 1) = Mid(sArr(i, 1), n + 1, m - n - 1)
Next
    Sheet2.[A2].Resize(i - 1, 1) = dArr
End Sub

Tại vì dữ liệu nguồn của em lại được xuất từ trong hệ thống file dạng *.csv và e copy vào 1 sheet trong file excel. từ sheet đó e lọc lấy những dữ liệu cần và cho vào báo cáo. Vì em code để lấy trực tiếp từ file *.csv nó không được nên mới làm thủ công.

Nếu bạn thích Macro:

Sub Macro1()
    Dim LR As Long, i As Long
    LR = Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    Columns(1).Copy Columns(9)
    For i = 2 To LR
        If Range("I" & i) <> Empty Then
            Range("I" & i).Replace "-", "/"
        End If
         Range("I" & i) = Split(Range("I" & i), "/")(1)
    Next i
       Application.ScreenUpdating = True
End Sub

Cách của bác rất hay. Có vẻ phù hợp với dữ liệu của em. Cảm ơn bác nhiều