code vba chuyển chuỗi thành text

[alex-luu]

Nhờ các anh chị chỉ giúp em code để chuyển chuỗi thành text
Cột S của em là mã số (ID) của từng thành viên, dữ liệu này là em import từ file báo cáo xuất ra từ phần mềm trên trang Web của công ty.
Tuy nhiên có lẽ dữ liệu này không đồng bộ về mặt định dạng, nên khi em dùng hàm vlookup để lọc thì có lúc được, có lúc không.
Em dùng thêm 1 cột phụ để chuyển dữ liệu này về dạng text ("########") thì mọi thứ ok.
Nhưng do dữ liệu quá nhiều >55.000 hàng nên file chạy rất nặng, em muốn hỏi là thay vì em phải dùng 1 cột phụ với hàm text(S3;"########") cho > 55.000 hàng, thì em có thể dùng VBA để sau khi import xong thì nó chuyển luôn nội dung cột A về dạng TEXT("########") được không ?



Câu hỏi thứ 2 : Em muốn dùng userform để tạo file nhập liệu, vừa cho phép import từ file báo cáo của công ty, vừa cho phép nhập liệu bằng tay (đề phòng trường hợp báo cáo chưa có kịp). Nhờ các anh chị viết giúp em code để có thể imoprt sales report và file báo cáo K2 vào theo cấu trúc file đính kèm.

Vấn đề cần lưu ý là nếu lần trước import dữ liệu đến hàng 500, thì khi nhập liệu bằng tay, nhấn ok, nó sẽ điền nội dung tiếp theo ở hàng 501.
Nếu dữ liệu đã có, mà tiếp tục nhấn nút import dữ liệu thì nó sẽ xóa hết toàn bộ vùng (R3:Z55.000) , rồi chèn dữ liệu từ báo cáo mới vào.

Lưu ý : nếu có import dữ liệu vào thì : cột mã số (cột S và cột V) phải được chuyển về dạng TEXT("########")
Cột W đến cột Z : chuyển về Value (number) . dữ liệu gốc trong file report, phần này đang định dạng kiểu text hay gì đó mà không thể dùng để tính toán được, em phải dùng thêm 4 cột phụ với hàm Value(Substitute( để loại bỏ dấu , thì mới tính toán được.


File report thì em chỉ cần lấy các cột Họ tên TVTC, Mã số, Chức danh, ngày tham gia, Quản lý, Số lượng phát hành, Phí BH mới, Phí BH năm đầu, Phí BH năm 2

​ Họ Tên TVTC	Mã số TVTC	Chức danh	Ngày tham gia	Quản lý	Số lượng phát hành (CC)	Phí BH mới (IP)	Phí BH năm đầu (FYP)	Phí BH năm hai (SYP)

Em cảm ơn các anh chị

 

[befaint]

Đơn giản là mình định dạng các cột đó ở dạng "Text" là được.

 

[alex-luu]

Đơn giản là mình định dạng các cột đó ở dạng "Text" là được.

Không được ạ, em đã thử, định dạng sẵn nó là text, rồi import vào, nó vẫn không vlookup dc, với mấy cột W đến Z cũng vậy, em đã định dạng là number rồi, mà khi import vào nó cũng không dùng để tính toán được. Cũng có thể là code import của em bị sai định dạng (em copy dc code import dữ liệu từ trên mạng).
Nhờ anh chị sửa lại hoặc viết giúp em đoạn code lấy dữ liệu từ file report với yêu cầu :

nếu có import dữ liệu vào thì : cột mã số (cột S và cột V) phải được chuyển về dạng TEXT("########")
Cột W đến cột Z : chuyển về Value (number) . dữ liệu gốc trong file report, phần này đang định dạng kiểu text hay gì đó mà không thể dùng để tính toán được, em phải dùng thêm 4 cột phụ với hàm Value(Substitute( để loại bỏ dấu , thì mới tính toán được.

Code hiện giờ em đang dùng :

Sub Lay_Report()
On Error Resume Next
Sheet1.Activate
Dim basebook As String
Dim mybook As Workbook
Dim fname As String
Dim Mypath As String
Application.ScreenUpdating = False
Mypath = Application.ActiveWorkbook.Path
basebook = ActiveWorkbook.Name
ChDrive Mypath
ChDir Mypath
fname = Application.GetOpenFilename(filefilter:="Execel files (*.xlsx), *.xlsx", Title:=" Chon file report de lay du lieu ... ", MultiSelect:=False)
Set mybook = Workbooks.Open(fname)

mybook.Worksheets(1).Active
ActiveSheet.ShowAllData
Range("A2:E60000").Select
Selection.Copy
Windows(basebook).Activate
Sheet1.Select
Range("R3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
mybook.Close False
Application.ScreenUpdating = True
Range("R3").Select

MsgBox " Da lay xong du lieu.", , "Luu thành công !!!"
End Sub

 

[befaint]

ActiveSheet.Paste

1/ Luôn luôn và luôn luôn nếu lấy giá trị thì Paste only values.

2/ Hoặc:

Sub Lay_Report() 
const rng_data =  "A2:E60000" 
const cell_target = "R3"
Dim data as variant
Dim ws as worksheet
Dim mybook As Workbook
Dim fname As variant
set ws = sheet1
fname = Application.GetOpenFilename(filefilter:="Execel files (*.xlsx), *.xlsx", Title:=" Chon file report de lay du lieu ... ", MultiSelect:=False)
If fname  = False Then exit sub
Set mybook = Workbooks.Open(fname) 
data =  mybook.Worksheets(1).Range("A2:E60000").value2
mybook.Close False
ws.range(cell_target).resize(ubound(data,1),ubound(data,2)).value=data
End sub

 

[alex-luu]

1/ Luôn luôn và luôn luôn nếu lấy giá trị thì Paste only values.

2/ Hoặc:

Sub Lay_Report()
const rng_data =  "A2:E60000"
const cell_target = "R3"
Dim data as variant
Dim ws as worksheet
Dim mybook As Workbook
Dim fname As variant
set ws = sheet1
fname = Application.GetOpenFilename(filefilter:="Execel files (*.xlsx), *.xlsx", Title:=" Chon file report de lay du lieu ... ", MultiSelect:=False)
If fname  = False Then exit sub
Set mybook = Workbooks.Open(fname)
data =  mybook.Worksheets(1).Range("A2:E60000").value2
mybook.Close False
ws.range(cell_target).resize(ubound(data,1),ubound(data,2)).value=data
End sub

Cảm ơn bạn rất nhiều.
Tuyệt vời !!!!
Phần dữ liệu lấy vào đúng như ý luôn, với mình có cảm giác nó chạy nhanh hơn rất nhiều so với cái code mình đang dùng.
Code mình đang dùng có 1 nhược điểm là nếu nhấn vào nút lấy dữ liệu, nó hiện lên bảng hỏi đường dẫn , mà mình nhấn cancel hoặc nhấn dấu x để thoát thì nó nhảy hàng, cột tùm lum, với cái nút lấy Report tự nhiên biến mất tiêu luôn. Code của bạn hình như mình thấy có dòng If fname = False Then exit sub nên không bị lỗi đó. phải không bạn ?

Cho mình hỏi thêm, có thể thay cái đoạn A2:E60000 thành Range("A2:E2", Range("A2:E2").End(xlDown)).Select được không ạ, ý là mình lấy từ hàng 2 đến 60.000 là mình dự phòng dư nhiều lắm, nên file sẽ nậng, có thể cho nó lấy vùng dữ liệu từ cột A, hàng thứ 2 trở đi đến hết thôi thì nó sẽ nhẹ file hơn không ?

Với lại, còn phần cột H đến cột K cũng phải lấy thì mình sẽ thêm code như thế nào ?

Cảm ơn bạn

 

[befaint]

.Select

Viết code lấy dữ liệu thì đừng bao giờ select.

Mình cần đọc lý thuyết nhiều vào, từ từ rành lý thuyết rồi làm sau cũng được.
Chịu khó đọc bài 5-6-10 đã. Nói chung không vội được.



------

Sub Lay_Report()
SpeedOn true
const range_start = "A2:E2"
const scol_ref = "A"
const row_start = 2
const cell_target = "R3"
Dim data as variant
Dim ws as worksheet
Dim fname As variant
set ws = sheet1
fname = Application.GetOpenFilename(filefilter:="Execel files (*.xlsx), *.xlsx", Title:=" Chon file report de lay du lieu ... ", MultiSelect:=False)
If fname  = False Then SpeedOn false: exit sub
data = GetSourceData(fname, range_start , scol_ref, row_start  )
if isarray(data) = false then msgbox "No data!" : SpeedOn false: exit sub
ws.range(cell_target).resize(ubound(data,1),ubound(data,2)).value=data
SpeedOn false
msgbox "Done!"
End sub
'----
Private Function GetSourceData(ByVal file_path As String, byval range_start as String, byval scol_ref as string, byval row_start as long) As Variant
    'file_path  : duong dan file can lay du lieu
    'range_start: dong bat dau vung du lieu
    'scol_ref   : cot tham chieu xac dinh vung co du lieu
    'row_start  : dia chi dong bat dau cua vung du lieu
    Dim wb As Workbook, ws As Worksheet, last_row As Long
    'get workbook data
    Set wb = get_workbook(file_path, True)
    Set ws = wb.Worksheets(1)
    show_all_cells ws
    'get last row
    last_row = get_last_row(ws, scol_ref)
    If last_row < row_start Then        'no data
        wb.Close False
        Exit Function
    End If
    'get data
    GetSourceData = ws.Range(range_start).Resize(last_row - row_start + 1 + 1).Value2
    wb.Close False
    Set wb = Nothing: Set ws = Nothing
End Function

Public Function get_workbook(ByVal book_path As String, Optional ByVal bln_read_only As Boolean = True) As Workbook
    Set get_workbook = Workbooks.Open(Filename:=book_path, UpdateLinks:=False, ReadOnly:=bln_read_only)
End Function
Public Sub show_all_cells(ByVal ws As Worksheet)
    If ws.FilterMode = True Then ws.ShowAllData
    ws.Cells.EntireRow.Hidden = False
    ws.Cells.EntireColumn.Hidden = False
End Sub
Public Function get_last_row(ByVal ws As Worksheet, ByVal col_name As String) As Long
    get_last_row = ws.Range(col_name & ws.Rows.Count).End(xlUp).row
End Function
Public Sub SpeedOn(ByVal bln As Boolean)
    With Application
        .ScreenUpdating = Not bln
        .DisplayAlerts = Not bln
        .AskToUpdateLinks = Not bln
        .Calculation = IIf(bln = True, xlCalculationManual, xlCalculationAutomatic)
    End With
End Sub

 

[alex-luu]

Viết code lấy dữ liệu thì đừng bao giờ select.

Mình cần đọc lý thuyết nhiều vào, từ từ rành lý thuyết rồi làm sau cũng được.
Chịu khó đọc bài 5-6-10 đã. Nói chung không vội được.

View attachment 251048

------

Sub Lay_Report()
SpeedOn true
const cell_target = "R3"
Dim data as variant
Dim ws as worksheet
Dim fname As variant
set ws = sheet1
fname = Application.GetOpenFilename(filefilter:="Execel files (*.xlsx), *.xlsx", Title:=" Chon file report de lay du lieu ... ", MultiSelect:=False)
If fname  = False Then SpeedOn false: exit sub
data = GetSourceData(fname)
if isarray(data) = false then msgbox "No data!" : SpeedOn false: exit sub
ws.range(cell_target).resize(ubound(data,1),ubound(data,2)).value=data
SpeedOn false
msgbox "Done!"
End sub
'----
Private Function GetSourceData(ByVal file_path As String, byval range_start as String, byval scol_ref as string, byval row_start as long) As Variant
    'file_path  : duong dan file can lay du lieu
    'range_start: dong bat dau vung du lieu
    'scol_ref   : cot tham chieu xac dinh vung co du lieu
    'row_start  : dia chi dong bat dau cua vung du lieu
    Dim wb As Workbook, ws As Worksheet, last_row As Long
    'get workbook data
    Set wb = get_workbook(file_path, True)
    Set ws = wb.Worksheets(1)
    show_all_cells ws
    'get last row
    last_row = get_last_row(ws, scol_ref)
    If last_row < row_start Then        'no data
        wb.Close False
        Exit Function
    End If
    'get data
    GetSourceData = ws.Range(range_start).Resize(last_row - row_start + 1 + 1).Value2
    wb.Close False
    Set wb = Nothing: Set ws = Nothing
End Function

Public Function get_workbook(ByVal book_path As String, Optional ByVal bln_read_only As Boolean = True) As Workbook
    Set get_workbook = Workbooks.Open(Filename:=book_path, UpdateLinks:=False, ReadOnly:=bln_read_only)
End Function
Public Sub show_all_cells(ByVal ws As Worksheet)
    If ws.FilterMode = True Then ws.ShowAllData
    ws.Cells.EntireRow.Hidden = False
    ws.Cells.EntireColumn.Hidden = False
End Sub
Public Function get_last_row(ByVal ws As Worksheet, ByVal col_name As String) As Long
    get_last_row = ws.Range(col_name & ws.Rows.Count).End(xlUp).row
End Function
Public Sub SpeedOn(ByVal bln As Boolean)
    With Application
        .ScreenUpdating = Not bln
        .DisplayAlerts = Not bln
        .AskToUpdateLinks = Not bln
        .Calculation = IIf(bln = True, xlCalculationManual, xlCalculationAutomatic)
    End With
End Sub

Nó báo lỗi vậy là sao bạn .

 

[befaint]

báo lỗi vậy là sao

Là làm sai, là viết sai chứ sao.

 

[alex-luu]

Là làm sai, là viết sai chứ sao.

Hì hì hì, mình làm phiền bạn nếu rảnh thì xem 1 lần nữa giúp cho mình nhé.
Cảm ơn bạn

 

[befaint]

Hì hì hì, mình làm phiền bạn nếu rảnh thì xem 1 lần nữa giúp cho mình nhé.
Cảm ơn bạn

Đã sửa lại luôn và ngay cách đây 1 tiếng rồi mà.

 

[alex-luu]

Đã sửa lại luôn và ngay cách đây 1 tiếng rồi mà.

À, ra là bạn sửa ngay trong bài viết trước, mình không hiểu ý, cứ ngồi chờ bài viết mới, hihihihi, cảm ơn bạn.
Với lại, còn phần cột H đến cột K cũng phải lấy thì mình sẽ thêm code như thế nào ? Trong file report, mình lấy 2 đoạn : cột A đến E, với cột H đến K
Lỡ phiền rồi, nhờ bạn bổ sung thêm giúp mình, vì đầu bài viết #1, mình có nói 2 đoạn (phần cột H đến K lấy xong dán vào file chính ở cột W đến Z (dán kiểu Number). phần dữ liệu trong file report cột H đến K nó là kiểu gì đó, không phải text nên mình phải dùng hàm value(substitute để loại bỏ dấu ,