Giúp em VBA code chuyển Number thành text với ạ

nhnn1986 · 9/10/19

Em chào Anh/Chị

Em có sheet("ketqua") muốn chuyển toàn bộ Cột(3) thành dạng text để có thể cộng bằng hàm Sum/Sumif.
Số liệu tại Cột(3) là số hiệu các tài khoản kế toán nên em cần dùng hàm Sum/Sumif cho nhanh và đơn giản
Em đã dùng thử code sau để Format mà vẫn không được:

Mã:

sheets("ketqua").columns(3).numberformat = "@"

Mong Anh/Chị giúp em với ạ.

phulien1902 · 9/10/19

nhnn1986 đã viết:
Em chào Anh/Chị

Em có sheet("ketqua") muốn chuyển toàn bộ Cột(3) thành dạng text để có thể cộng bằng hàm Sum/Sumif.
Số liệu tại Cột(3) là số hiệu các tài khoản kế toán nên em cần dùng hàm Sum/Sumif cho nhanh và đơn giản
Em đã dùng thử code sau để Format mà vẫn không được:

Mã:

sheets("ketqua").columns(3).numberformat = "@"

Mong Anh/Chị giúp em với ạ.

Có File mới có hướng giải quyết.

HieuCD · 9/10/19

nhnn1986 đã viết:
Em chào Anh/Chị

Em có sheet("ketqua") muốn chuyển toàn bộ Cột(3) thành dạng text để có thể cộng bằng hàm Sum/Sumif.
Số liệu tại Cột(3) là số hiệu các tài khoản kế toán nên em cần dùng hàm Sum/Sumif cho nhanh và đơn giản
Em đã dùng thử code sau để Format mà vẫn không được:

Mã:

sheets("ketqua").columns(3).numberformat = "@"

Mong Anh/Chị giúp em với ạ.

Chạy code

Mã:

Sub ABC()
  Dim Arr(), Res() As String, i&, sRow&
  On Error Resume Next
  With Sheets("ketqua")
    Arr = .Range("C1", .Range("c" & Rows.Count).End(xlUp)).Value
    sRow = UBound(Arr)
    ReDim Res(1 To sRow, 1 To 1)
    For i = 1 To sRow
      Res(i, 1) = Arr(i, 1)
    Next i
    .Range("C1").Resize(sRow).Value = Res
  End With
End Sub

phulien1902 · 9/10/19

Vừa rồi không đọc kỹ yêu càu đổi số thành Text, không phải Text thành số.
Có thể dùng cách khác:

PHP:

Sub Test()
Selection.TextToColumns DataType:=xlDelimited, FieldInfo:=Array(1, 2)
End Sub

nhnn1986 · 9/10/19

Dạ cảm ơn Mr @HieuCD nhiều ạ, code chạy đúng ý em rồi ạ.

Em đang tổng hợp các bảng CĐKT bằng code bên dưới và giá trị f2 là cột chứa số hiệu CĐKT (cột f2 ở dòng "Set rs =cn....)
Vậy giờ em muốn ngay tại lúc lấy dữ liệu đã mặc định f2 phải định dạng text thì code sửa thế nào ạ?

Mã:

Public Sub DATA_CDKT()
Dim cn As Object, rs As Object, i As Byte, lr As Long, fso As Object, NewSh As Worksheet
Set cn = CreateObject("adodb.connection")
Set fso = CreateObject("Scripting.FileSystemObject")
set newsh = thisworkbook.sheet("CDKT_Total")
Application.ScreenUpdating = False
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "CDKT01", "*.xl*"
        .InitialFileName = "*CDKT01*.*"
        .AllowMultiSelect = True
        .Show
        For i = 1 To .SelectedItems.Count
        If Val(Application.Version) < 12 Then
            cn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & .SelectedItems(i) & ";mode=Read;Extended Properties=""Excel 8.0;HDR=No"";")
            Else
            cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & .SelectedItems(i) & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
        End If
        Set rs = cn.Execute("select '" & fso.GetBaseName(.SelectedItems(i)) & "',f1,f2,val(f3),val(f4),val(f5),val(f6) from [CDKT011$B9:G97] ")
            lr = NewSh.Range("A" & Rows.Count).End(3).Row
            If Not rs.EOF Then NewSh.Range("A" & lr + 1).CopyFromRecordset rs
            rs.Close
            cn.Close
        Next
    End With
Application.ScreenUpdating = True

End Sub

À em có 02 câu hỏi nữa liên quan đến đoạn code này mà không rõ hỏi ở đây luôn có tiện không ạ? sợ lệch tiêu đề, nếu sai thì mạn phép bỏ qua cho em và không cần trả lời đâu ạ ^!^
Code trên dùng tốt cho Office 2010 trở lên, còn Office 2007 thì bị lỗi:

Đoạn code này không có tác dụng lọc các dile có ký tự đầu tiên là "CDKT01" nên trong folder hiện tất cả các file excel gây rồi mắt trong khi em chỉ cần Folder đó chỉ hiện các file có các ký tự đầu là "CDKT01"
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "CDKT01", "*.xl*"
.InitialFileName = "*CDKT01*.*"
.AllowMultiSelect = True
.Show

Một lần nữa cảm ơn Mr @HieuCD và Anh/Chị đã ghé qua topic, nếu được xin giúp đỡ em thêm lần nữa ạ

HieuCD · 9/10/19

nhnn1986 đã viết:
Dạ cảm ơn Mr @HieuCD nhiều ạ, code chạy đúng ý em rồi ạ.

Em đang tổng hợp các bảng CĐKT bằng code bên dưới và giá trị f2 là cột chứa số hiệu CĐKT (cột f2 ở dòng "Set rs =cn....)
Vậy giờ em muốn ngay tại lúc lấy dữ liệu đã mặc định f2 phải định dạng text thì code sửa thế nào ạ?

Mã:

Public Sub DATA_CDKT() Dim cn As Object, rs As Object, i As Byte, lr As Long, fso As Object, NewSh As Worksheet Set cn = CreateObject("adodb.connection") Set fso = CreateObject("Scripting.FileSystemObject") set newsh = thisworkbook.sheet("CDKT_Total") Application.ScreenUpdating = False With Application.FileDialog(msoFileDialogOpen) .Filters.Clear .Filters.Add "CDKT01", "*.xl*" .InitialFileName = "*CDKT01*.*" .AllowMultiSelect = True .Show For i = 1 To .SelectedItems.Count If Val(Application.Version) < 12 Then cn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & .SelectedItems(i) & ";mode=Read;Extended Properties=""Excel 8.0;HDR=No"";") Else cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & .SelectedItems(i) & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";") End If Set rs = cn.Execute("select '" & fso.GetBaseName(.SelectedItems(i)) & "',f1,f2,val(f3),val(f4),val(f5),val(f6) from [CDKT011$B9:G97] ") lr = NewSh.Range("A" & Rows.Count).End(3).Row If Not rs.EOF Then NewSh.Range("A" & lr + 1).CopyFromRecordset rs rs.Close cn.Close Next End With Application.ScreenUpdating = True End Sub

À em có 02 câu hỏi nữa liên quan đến đoạn code này mà không rõ hỏi ở đây luôn có tiện không ạ? sợ lệch tiêu đề, nếu sai thì mạn phép bỏ qua cho em và không cần trả lời đâu ạ ^!^
Code trên dùng tốt cho Office 2010 trở lên, còn Office 2007 thì bị lỗi:

Đoạn code này không có tác dụng lọc các dile có ký tự đầu tiên là "CDKT01" nên trong folder hiện tất cả các file excel gây rồi mắt trong khi em chỉ cần Folder đó chỉ hiện các file có các ký tự đầu là "CDKT01"
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "CDKT01", "*.xl*"
.InitialFileName = "*CDKT01*.*"
.AllowMultiSelect = True
.Show

Một lần nữa cảm ơn Mr @HieuCD và Anh/Chị đã ghé qua topic, nếu được xin giúp đỡ em thêm lần nữa ạ

Mình dùng Excel 2007 không bị lổi

Mã:

Public Sub DATA_CDKT()
Dim cn As Object, rs As Object, i As Byte, lr As Long, fso As Object, NewSh As Worksheet
Set cn = CreateObject("adodb.connection")
Set fso = CreateObject("Scripting.FileSystemObject")
Set NewSh = ThisWorkbook.Sheet("CDKT_Total")
Application.ScreenUpdating = False
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "CDKT01", "*.xl*"
        .InitialFileName = "*CDKT01*.*"
        .AllowMultiSelect = True
        .Show
        For i = 1 To .SelectedItems.Count
        If Val(Application.Version) < 12 Then
            cn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & .SelectedItems(i) & ";mode=Read;Extended Properties=""Excel 8.0;HDR=No"";")
            Else
            cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & .SelectedItems(i) & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
        End If
        Set rs = cn.Execute("select '" & fso.GetBaseName(.SelectedItems(i)) & "',f1,cstr(f2),val(f3),val(f4),val(f5),val(f6) from [CDKT011$B9:G97] ")
            lr = NewSh.Range("A" & Rows.Count).End(3).Row
            If Not rs.EOF Then NewSh.Range("A" & lr + 1).CopyFromRecordset rs
            rs.Close
            cn.Close
        Next
    End With
    Set cn = Nothing: Set rs = Nothing
Application.ScreenUpdating = True
End Sub

nhnn1986 · 9/10/19

Cảm ơn Mr @HieuCD ạ

Giúp em VBA code chuyển Number thành text với ạ

nhnn1986

Thành viên hoạt động

phulien1902

GPE - My love

HieuCD

Chuyên gia GPE

phulien1902

GPE - My love

nhnn1986

Thành viên hoạt động

HieuCD

Chuyên gia GPE

nhnn1986

Thành viên hoạt động

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

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

Đếm ngược thời gian