Code VBA định dạng dữ liệu cột F và G là Text và canh giữa.

[DMQ]

Chào các anh chị !!!!!
Em có code lấy dữ liệu, nhưng khi dữ liệu đập vào cột F và G thì không định dạng Text nên dùng Vlookup không ra.
Mà dữ liệu đập vào có cả Text và Number, mong các anh chị giúp đỡ.

 

[BuiQuangThuan]

Chào các anh chị !!!!!
Em có code lấy dữ liệu, nhưng khi dữ liệu đập vào cột F và G thì không định dạng Text nên dùng Vlookup không ra.
Mà dữ liệu đập vào có cả Text và Number, mong các anh chị giúp đỡ.

Trước khi gán xuống sheet thì xử lý nó trước nó đi anh

 

[DMQ]

Bạn chỉ mình với, code đây:

Option Explicit

Sub LaySheetXuat()
Dim fd As Workbook, sd As Worksheet, sn As Worksheet, mn, lrd As Long, lrn As Long, i As Long, j As Long, k As Long, p As Long, ktts As Long, tensheet As Long
Dim chonFile, openfile

Application.ScreenUpdating = False
Application.DisplayAlerts = False
    
Set fd = ThisWorkbook
'Mo thuoc tinh File Open
chonFile = Application.GetOpenFilename(Title:="Chon file du lieu can lay", filefilter:="exel file(*.xls*),*.xls*", MultiSelect:=True)
    On Error Resume Next
For i = 1 To UBound(chonFile)
    On Error GoTo 0
    If i = 0 Then Exit Sub
    Set openfile = Workbooks.Open(chonFile(i), False)
    
    With openfile
        For ktts = 1 To Sheets.Count    'Kiem tra xem file co ten sheets can lay du lieu khong
            If Sheets(ktts).Name = "Xuat" Then
                tensheet = tensheet + 1
                Exit For
            End If
        Next ktts

        If tensheet = 0 Then   'Neu file khong co ten sheet nao giong thi dong file và thoát khoi Sub
            openfile.Close
            MsgBox "Khong co sheets nào giông tên sheet cân lay du lieu, vui long chon lai file khac"
            GoTo thoat
        End If
    
        For j = 1 To fd.Sheets.Count
            For p = 1 To .Sheets.Count
                If fd.Sheets(j).Name = .Sheets(p).Name Then  'Nêu ten file nguon giong ten file dich thi lay du lieu
                    Set sd = fd.Sheets(j): lrd = sd.Cells(Rows.Count, 1).End(xlUp).Row
                    Set sn = openfile.Sheets(p): lrn = sn.Cells(Rows.Count, 1).End(xlUp).Row
                    mn = sn.Range("A6:P" & lrn): sd.Range("A" & lrd + 1).Resize(lrn - 4, 16) = mn
                    sd.Range("A" & lrd + 1).Resize(lrn - 4, 16).Borders.LineStyle = True
                j = j + 1
                End If
            Next p
        Next j
    End With
openfile.Close
thoat:
Next i

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[BuiQuangThuan]

Bạn chỉ mình với, code đây:

Nếu em gửi cho anh 1 cái ảnh. Xong bảo anh khám bệnh anh có chịu khám không?

 

[Hoàng Tuấn 868]

Nếu em gửi cho anh 1 cái ảnh. Xong bảo anh khám bệnh anh có chịu khám không?

Mình nhận ra code này của mình.

 

[BuiQuangThuan]

Mình nhận ra code này của mình.

Thế anh vào chữa đi kìa. Gặp con ruột thì thớt mở cờ được rồi.

 

[DMQ]

lấy ở đây ạ. Anh @Hoàng Tuấn 868

 

[Hoàng Tuấn 868]

Mà dữ liệu đập vào

Dữ liệu người ta nâng như nâng trứng mà đem đập vào cột thì hỏng hết dữ liệu còn gì bạn ơi.

con ruột

Thấy có bạn vác đi đập vào cột này, cột kia đang xót hết cả ruột đây này.

 

[DMQ]

Cột F và cột G, sau khi định dạng bằng tay nè anh @Hoàng Tuấn 868

 

[Hoàng Tuấn 868]

Cột F và cột G, sau khi định dạng bằng tay nè anh @Hoàng Tuấn 868
View attachment 296955

Không có file thì mai lại tiếp tục hàn huyên nhỉ.

 

[DMQ]

sao em thử thêm đoạn code này mà không được:

sd.Range("F:G" & lrd + 1) = "'" & sd.Range("F:G" & lrd + 1)
sd.Range("F:G" & lrd + 1).Resize(r, 2).NumberFormat = "@"

 

[Hoàng Tuấn 868]

không được:

Nhất định không đưa file để thử thì đành dừng ở đây vậy.

 

[CHAOQUAY]

sao em thử thêm đoạn code này mà không được:

sd.Range("F:G" & lrd + 1) = "'" & sd.Range("F:G" & lrd + 1)
sd.Range("F:G" & lrd + 1).Resize(r, 2).NumberFormat = "@"

Range("F:G" & lrd + 1)

Range("F" & lrd + 1 & ":G" & lrd + 1)

Thử sửa trên thành dưới xem sao

 

[DMQ]

Code thêm dấu nháy đơn không được anh @CHAOQUAY ơi

 

[DMQ]

sd.Range("F" & lrd + 1 & ":G" & lrd + 1).Resize(r, 1).NumberFormat = "@"

Code trên đã chuyển Text, nhưng các số 001,002,003,..v..vv thì lại biến thành 1,2,3.vv... mất các số không anh @CHAOQUAY ơi, mong anh giúp.

 

[CHAOQUAY]

sd.Range("F" & lrd + 1 & ":G" & lrd + 1).Resize(r, 1).NumberFormat = "@"

Code trên đã chuyển Text, nhưng các số 001,002,003,..v..vv thì lại biến thành 1,2,3.vv... mất các số không anh @CHAOQUAY ơi, mong anh giúp.

Bạn chạy thử file dưới đây rồi tính tiếp

 

[DMQ]

Chạy thấy đúng ý rồi anh ơi, nhưng không biết vận dụng anh @CHAOQUAY ơi.

 

[CHAOQUAY]

Chạy thấy đúng ý rồi anh ơi, nhưng không biết vận dụng anh @CHAOQUAY ơi.

Thấy nói là phải định dạng vùng đích trước khi điền dữ liệu nguồn, cái này không chắc lắm, hình như là thế thì phải, lâu rồi quên

Trong bài 3, bạn thử thêm dòng này

sd.Range("A" & lrd + 1).Resize(lrn - 4, 16).NumberFormat = "@"

Phía trên dòng này

mn = sn.Range("A6:P" & lrn): sd.Range("A" & lrd + 1).Resize(lrn - 4, 16) = mn

Rồi chạy thử xem sao

 

[DMQ]

dùng "@" thì nó định dạng Text, nhưng các số có số o đầu mất hết, như các mã số 041584,07712,010457 ... thành 41584,7712,10457.... anh @CHAOQUAY

Bài đã được tự động gộp: 23/11/23

em thấy có cách thêm dấu ' trước số thành chuỗi, hay convert thành String

 

[CHAOQUAY]

dùng "@" thì nó định dạng Text, nhưng các số có số o đầu mất hết, như các mã số 041584,07712,010457 ... thành 41584,7712,10457.... anh @CHAOQUAY

Bài đã được tự động gộp: 23/11/23

em thấy có cách thêm dấu ' trước số thành chuỗi, hay convert thành String

Tức là đã thử rồi?