Nhờ định dạng lại sau khi chạy code (1 người xem)

[lhthai]

Mình có đoạn code kiểm tra các mã hàng nào thay đổi thì báo "Check" ở cột F nhưng muốn giữ định dạng cột E như lúc ban đầu.
Anh Chị nào có cách nào khác hướng dẫn thêm.

Private Sub CommandButton1_Click()
Dim I As Long, Arr(), dArr(), j As Long, K As Long, Tem As String
Set Dic = CreateObject("scripting.dictionary")
   With Sheet2
     Arr = .Range("A14", .[A65536].End(3)).Resize(, 6).Value
      End With
   For I = 1 To UBound(Arr)
   Tem = Arr(I, 1) & Arr(I, 2) & Arr(I, 3)
      If Not Dic.exists(Tem) Then
          Dic.Add Tem, Empty
              End If
   Next
   With Sheet1
   dArr = .Range("A5", .[A65536].End(3)).Resize(, 6).Value
      End With
   For I = 1 To UBound(dArr)
   Tem = dArr(I, 1) & dArr(I, 2) & dArr(I, 3)
      If Not Dic.exists(Tem) Then
            dArr(I, 6) = "Check"
      End If
      Next
   With Sheet1
   .[A5].Resize(I - 1, 6) = dArr
     End With
End Sub

 

[dovanhoc84]

bức bối quá thì thêm 1 dòng code dưới vào ngay đoạn đầu là được mà?

Columns("E:E").NumberFormat = "@"

 

[ndu96081631]

Mình có đoạn code kiểm tra các mã hàng nào thay đổi thì báo "Check" ở cột F nhưng muốn giữ định dạng cột E như lúc ban đầu.
Anh Chị nào có cách nào khác hướng dẫn thêm.

Private Sub CommandButton1_Click()
Dim I As Long, Arr(), dArr(), j As Long, K As Long, Tem As String
Set Dic = CreateObject("scripting.dictionary")
   With Sheet2
     Arr = .Range("A14", .[A65536].End(3)).Resize(, 6).Value
      End With
   For I = 1 To UBound(Arr)
   Tem = Arr(I, 1) & Arr(I, 2) & Arr(I, 3)
      If Not Dic.exists(Tem) Then
          Dic.Add Tem, Empty
              End If
   Next
   With Sheet1
   dArr = .Range("A5", .[A65536].End(3)).Resize(, 6).Value
      End With
   For I = 1 To UBound(dArr)
   Tem = dArr(I, 1) & dArr(I, 2) & dArr(I, 3)
      If Not Dic.exists(Tem) Then
            dArr(I, 6) = "Check"
      End If
      Next
   With Sheet1
   .[A5].Resize(I - 1, 6) = dArr
     End With
End Sub

Cần gán chỗ nào thì tạo mảng gọn chỗ đó thôi. Tự dưng mang hết "nguyên con" dữ liệu có sẵn vào mảng rồi "đập" ngược trở lại, "nó" sẽ bị biến đổi trong một số trường hợp (liên quan đến number format)
Tôi sửa thành vầy:

Private Sub CommandButton1_Click()
  Dim I As Long, Arr(), dArr(), j As Long, K As Long, Tem As String
  Dim dic As Object
  Set dic = CreateObject("Scripting.Dictionary")
  Arr = Sheet2.Range("A14", Sheet2.Range("A65536").End(3)).Resize(, [COLOR=#ff0000]3[/COLOR]).Value
  For I = 1 To UBound(Arr)
    Tem = Arr(I, 1) & Arr(I, 2) & Arr(I, 3)
    If Not dic.Exists(Tem) Then dic.Add Tem, Empty
  Next
  dArr = Sheet1.Range("A5", Sheet1.Range("A65536").End(3)).Resize(, [COLOR=#ff0000]3[/COLOR]).Value
  [COLOR=#ff0000]ReDim aTmp(1 To UBound(dArr, 1), 1 To 1) As String[/COLOR]
  For I = 1 To UBound(dArr)
    Tem = dArr(I, 1) & dArr(I, 2) & dArr(I, 3)
    If Not dic.Exists(Tem) Then [COLOR=#ff0000]aTmp(I, 1) = "Check"[/COLOR]
  Next
  [COLOR=#ff0000]Sheet1.Range("F5").Resize(I - 1) = aTmp[/COLOR]
End Sub

Chỗ màu đỏ là thêm vào và sửa lại
-----------------------------
Ngoài lề:
- Các bạn muốn học viết code thì điều trước tiên nên tập cách trình bày rõ ràng. Viết theo kiểu "thụt vào, ló ra" tùy tiện, chẳng ai đọc code nỗi đâu
- Khai báo biến đầy đủ