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

Liên hệ QC
A

alex-luu

Thành viên thường trực
Tham gia
10/3/15
Bài viết
300
Được thích
52
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 ?

1607662933573.png

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.
1607663301826.png

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ố TVTCChức danhNgày tham giaQuả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ị
 

File đính kèm

  • report trên web.xlsx
    23.3 KB · Đọc: 7
  • chuyen code ve dang text.xlsm
    58.4 KB · Đọc: 12
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Đơn giản là mình định dạng các cột đó ở dạng "Text" là được.
 
Upvote 0
befaint đã viết:
Đơn giản là mình định dạng các cột đó ở dạng "Text" là được.
Nhấp chuột vào đây để mở rộng...

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
 
Upvote 0
alex-luu đã viết:
ActiveSheet.Paste
Nhấp chuột vào đây để mở rộng...
1/ Luôn luôn và luôn luôn nếu lấy giá trị thì Paste only values.

2/ Hoặc:
PHP: 
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
 
Upvote 0
befaint đã viết:
1/ Luôn luôn và luôn luôn nếu lấy giá trị thì Paste only values.

2/ Hoặc:
PHP: 
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
Nhấp chuột vào đây để mở rộng...

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
 
Lần chỉnh sửa cuối:
Upvote 0
alex-luu đã viết:
.Select
Nhấp chuột vào đây để mở rộng...
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.

1607670705457.png

------

PHP: 
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
 
Lần chỉnh sửa cuối:
Upvote 0
befaint đã viết:
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

------

PHP: 
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
Nhấp chuột vào đây để mở rộng...

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

1607671765280.png
 
Upvote 0
befaint đã viết:
Đã sửa lại luôn và ngay cách đây 1 tiếng rồi mà.
Nhấp chuột vào đây để mở rộng...

À, 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 ,
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

K
Nhờ mọi người hỗ trợ giúp mình về tìm kiếm trong VBA. Mình sẽ gửi chút chi phí cafe cám ơn nhiều ạ
Trả lời
9
Đọc
91
befaint
befaint
S
Nhờ giúp đỡ code in toàn bộ danh sách có điều kiện
Trả lời
12
Đọc
318
S.Ha
S
phammaihuong90
Hàm tìm ngày gần nhất đạt được số lượng mục tiêu
Trả lời
8
Đọc
193
DeTong
D
Emyeuexcel
  • Question
VBA lưu file, in, và mở lại file gốc ban đầu
2
Trả lời
21
Đọc
368
Emyeuexcel
Emyeuexcel
hongquan93vn
Giữ được Hide dòng khi dùng "clear" trong phần học
Trả lời
3
Đọc
62
Hoàng Tuấn 868
H
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom