Định dạng dữ liệu (1 người xem)

[chisinhvnn]

Mình có ghi macro để định dạng dữ liệu, nhưng có điều kiện dữ liệu bằng tiếng việt nên VBA không hiểu. Nhờ GPE hoàn thiện giúp mình với

 

[HieuCD]

Em không nghĩ được cách nào anh ạ. Anh ra tay làm giúp anh ấy đi. (mà anh ấy định dạng cột số lượng mà mấy bài trước em lại đị định dạng cột thành tiền hì hì...)

thử với code

Sub Dinhdang()
Dim Rng1 As Range, Rng2 As Range, Rng3 As Range
Dim LastR As Long, i As Long, Darr As Variant, Donvi As String
Application.ScreenUpdating = False
Donvi = "cái,cây,b" & ChrW(7909) & "i," & ChrW(273) & "/b" & ChrW(7909) & "i," & ChrW(273) & "/cây," & ChrW(273) & ChrW(7891) & "ng/thuêbao,g" & ChrW(7889) & "c,su" & ChrW(7845) & "t"
With Sheets("tham dinh (2)")
  LastR = .Range("B65535").End(3).Row
  Darr = .Range("A1", "C" & LastR).Value
  .Range("D5", "H" & LastR).NumberFormat = "#,##0.00"
  With .Range("A5", "H" & LastR)
    .Font.Bold = False
    .Borders.LineStyle = xlContinuous
    .Borders(xlInsideHorizontal).Weight = xlHairline
  End With
  Set Rng1 = .Range("A5:H6")
  Set Rng2 = .Range("D6")
  For i = 8 To UBound(Darr)
    If Darr(i, 1) = Empty Then
      If InStr(Donvi, LCase(Darr(i, 3))) Then Set Rng2 = Union(Rng2, .Range("D" & i))
    Else
      Set Rng1 = Union(Rng1, .Range("A" & i, "H" & i))
    End If
  Next i
  With Rng1
    .Font.Bold = True
    .Borders(xlEdgeBottom).Weight = xlThin
    .Borders(xlInsideHorizontal).Weight = xlThin
    .Borders(xlEdgeTop).Weight = xlThin
  End With
  Rng2.NumberFormat = "#,##0"
End With
Application.ScreenUpdating = True
End Sub

 

[PacificPR]

thử với code

Code trên Cái đơn vị đồng/cây nó vẫn có 2 số sau dấu phẩy anh ạ
Hôm nay học thêm từ Anh hàm ghép range . Hì Hì
Em dùng Dictionary. Duyệt qua mảng đơn vị cũng thấy ổn anh ạ

Sub Dinhdang1()
    Dim Er As Long, i As Long, J As Long, tArr, R As Long
    Dim Rng1 As Range, Rng2 As Range, Rng3 As Range
    Dim Dic As Object, Tem As String
    Set Dic = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
    With Sheet1
        tArr = .Range("A2", .Range("A65535").End(3)).Value
    End With
    For i = 1 To UBound(tArr)
        Dic.Item(UCase(tArr(i, 1))) = i
    Next i
    With Sheet3
        Set Rng1 = .Range("A5:H6")
        Set Rng2 = .Range("D6")
        Er = .Range("B65535").End(3).Row
        '.Range("D5", "D" & Er).NumberFormat = "General"
        With .Range("A5", "A" & Er).Resize(, 8)
            .Font.Bold = False
            .Borders.LineStyle = xlContinuous
            .Borders(xlInsideHorizontal).Weight = xlHairline
        End With
        For i = 1 To Er
            If i > 4 Then
                If .Range("A" & i) <> Empty Then
                    Set Rng1 = Union(Rng1, .Range("A" & i, "H" & i))
                End If
                If .Range("A" & i) = Empty Then
                    Tem = UCase(.Range("C" & i))
                    R = Dic.Item(Tem)
                    If R Then
                        Set Rng2 = Union(Rng2, .Range("D" & i))
                    Else
                        Set Rng3 = Union(Rng2, .Range("D" & i))
                    End If
                End If
            End If
        Next i
        With Rng1
            .Font.Bold = True
            .Borders(xlEdgeBottom).Weight = xlThin
            .Borders(xlInsideHorizontal).Weight = xlThin
            .Borders(xlEdgeTop).Weight = xlThin
        End With
        Rng2.NumberFormat = "#,##0"
        Rng3.NumberFormat = "#,##0.00"
    End With
    Application.ScreenUpdating = True
End Sub

 

[chisinhvnn]

Code trên Cái đơn vị đồng/cây nó vẫn có 2 số sau dấu phẩy anh ạ
Hôm nay học thêm từ Anh hàm ghép range . Hì Hì
Em dùng Dictionary. Duyệt qua mảng đơn vị cũng thấy ổn anh ạ

Sub Dinhdang1()
    Dim Er As Long, i As Long, J As Long, tArr, R As Long
    Dim Rng1 As Range, Rng2 As Range, Rng3 As Range
    Dim Dic As Object, Tem As String
    Set Dic = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
    With Sheet1
        tArr = .Range("A2", .Range("A65535").End(3)).Value
    End With
    For i = 1 To UBound(tArr)
        Dic.Item(UCase(tArr(i, 1))) = i
    Next i
    With Sheet3
        Set Rng1 = .Range("A5:H6")
        Set Rng2 = .Range("D6")
        Er = .Range("B65535").End(3).Row
        '.Range("D5", "D" & Er).NumberFormat = "General"
        With .Range("A5", "A" & Er).Resize(, 8)
            .Font.Bold = False
            .Borders.LineStyle = xlContinuous
            .Borders(xlInsideHorizontal).Weight = xlHairline
        End With
        For i = 1 To Er
            If i > 4 Then
                If .Range("A" & i) <> Empty Then
                    Set Rng1 = Union(Rng1, .Range("A" & i, "H" & i))
                End If
                If .Range("A" & i) = Empty Then
                    Tem = UCase(.Range("C" & i))
                    R = Dic.Item(Tem)
                    If R Then
                        Set Rng2 = Union(Rng2, .Range("D" & i))
                    Else
                        Set Rng3 = Union(Rng2, .Range("D" & i))
                    End If
                End If
            End If
        Next i
        With Rng1
            .Font.Bold = True
            .Borders(xlEdgeBottom).Weight = xlThin
            .Borders(xlInsideHorizontal).Weight = xlThin
            .Borders(xlEdgeTop).Weight = xlThin
        End With
        Rng2.NumberFormat = "#,##0"
        Rng3.NumberFormat = "#,##0.00"
    End With
    Application.ScreenUpdating = True
End Sub

code này vẫn còn lỗi đ/cây afh.

 

[PacificPR]

code này vẫn còn lỗi đ/cây afh.

Anh xóa dấu nháy đỏ của dòng này đi

'.Range("D5", "D" & Er).NumberFormat = "General"​

thử xem