Các câu hỏi về mảng trong VBA (Array)

viehoai · 24/3/11

Xin các anh chị giúp đỡ Code Gán các giá trị của một Range là các phần tử của Mãng
Ví dụ: Tôi có các giá trị của Range("A1:A10"). Tôi muốn viết code để gán giá trị của các cells từ A1:A10 là các phần tử của Mãng Arr chẳn hạn.
Xin cảm ơn các anh chị

PacificPR · 7/1/19

tam888 đã viết:
Đề nghị OanhTho phải đọc lại VBA từ Cơ bản
Tôi cảm thấy bạn học từ diễn đàn này lung tung quá - nói khác là học từ giữa ra hay cao xuống thì phải --- Nếu không phải thì bỏ qua, coi như tôi chưa viết.

So ở đây là tham số - bạn phải đọc code của họ thì sẽ hiểu so là gì --> so chính là thứ tự cột xét trùng (với code gốc bạn tham chiếu từ website của tây nhé) -- các cột sửa lại chỉnh lý sau thì tương tự, chỉ riêng với dk=2 thì lúc này so lại là thứ tự dòng (ở đây =1 luôn, vì họ chỉ xét mảng có một dòng A#:Q#)

Em cũng học theo kiểu của Bạn ý. Hôm trước có Anh nói là học theo kiểu "Tụt từ ngọn xuống gốc" đấy ạ

snow25 · 7/1/19

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào snow25,
Bạn có thể giải thích thêm tham số Optional ByVal so = 1, trong:

Có tác dụng gì thế ạ?
If Not .exists(MyArray(i, so)) Then

OT thử thay thẳng số 1 vào:
If Not .exists(MyArray(i, 1)) Then
và sửa thành:

Thì code không có lỗi gì.
Như vậy cái "Optional ByVal so=1" dùng để lựa chọn trong trường hợp đặc biệt nào vậy ạ?

Cái đấy là chiều thứ 2 của mảng đó.Bỏ đi thay bằng 1 cũng không sao thì nó luôn chọn cột 1.

tam888 · 7/1/19

PacificPR đã viết:
Em cũng học theo kiểu của Bạn ý. Hôm trước có Anh nói là học theo kiểu "Tụt từ ngọn xuống gốc" đấy ạ

Học kiểu đó , cảm giác nhanh có ích
nhưng động vào code bài khác khác kiểu đã biết, là dễ tẩu hỏa
Tuy thế cũng có nhiều người có đầu óc nhanh nhạy và thích ứng tốt - và thành công

Hoàng Nhật Phương · 7/1/19

tam888 đã viết:
Đề nghị OanhTho phải đọc lại VBA từ Cơ bản
Tôi cảm thấy bạn học từ diễn đàn này lung tung quá - nói khác là học từ giữa ra hay cao xuống thì phải --- Nếu không phải thì bỏ qua, coi như tôi chưa viết.

So ở đây là tham số - bạn phải đọc code của họ thì sẽ hiểu so là gì --> so chính là thứ tự cột xét trùng (với code gốc bạn tham chiếu từ website của tây nhé) -- các codes sửa lại chỉnh lý sau thì tương tự, chỉ riêng với dk=2 thì lúc này so lại là thứ tự dòng (ở đây =1 luôn, vì họ chỉ xét mảng có một dòng A#:Q#)
Nên có thể người ta thích cột xét trùng là cột khác
Lưu ý hàm tẩy (remove ... ) trùng RemoveDupesDict ở đây chỉ xét 1 cột trùng của bảng MyArray

Xin chào tam888,
Cảm ơn bạn đã quan tâm và góp ý ạ.
Thực ra cách đây 2 tháng OT cũng cày code ác lắm ấy chứ, nhưng sau đó lại học thêm tiếng Nhật xen lẫn nên quên quên nhớ nhớ.
Xong mới đây lại dính vụ bọn trẻ thi học kỳ I nên OT phải kèm tụi nhỏ và 1 thời gian ngắn code cũng quên hết sạch. T_T
Dạ, đúng OT hay tìm hiểu những cái áp dụng cho công việc của OT không tìm hiểu bài bản từ đầu nên mới nông nỗi này.
OT vẫn hi vọng sau này sẽ có thêm nhiều thời gian rảnh để cày ạ

HeSanbi · 7/1/19

@Nguyễn Hoàng Oanh Thơ
Code dưới của tôi nâng cấp lại code của @snow25, tăng thêm chút khả năng hữu dụng của Hàm

Sử dụng: Nằm ở sub Test
Diễn giải:
Hàm RemoveDupesArray2D sẽ trả lại kết quả của một mảng phụ thuộc tham số nhập vào:
1. DataArr - Nhập mảng
2. isRow - Lọc theo hàng (True) / cột (False)
3. NumRC - Thứ tự Cột hoặc hàng để lọc dữ liệu trùng
4. isTrans - Chuyển đổi mảng từ dọc sang ngang hoặc ngang sang dọc ( True/ False)
5. CellsResult - Nhập vào một Cells . Hàm sẽ trả kết quả tại Cells này

PHP:

Sub Test_RemoveDupesArray2D()
  Sheet1.Range("A12:AH100").ClearContents
  Dim Arr: Arr = Sheet1.Range("A1:Q2").Value
    Call RemoveDupesArray2D(Arr, NumRC:=2, isRow:=False, _
                          isTrans:=False, CellsResult:=Sheet1.Range("A4"))
      
    Call RemoveDupesArray2D(Arr, NumRC:=2, isRow:=False, _
                          isTrans:=True, CellsResult:=Sheet1.Range("S4"))

    Call RemoveDupesArray2D(Arr, NumRC:=1, isRow:=True, _
                          isTrans:=False, CellsResult:=Sheet1.Range("A22"))
                          
    Call RemoveDupesArray2D(Arr, NumRC:=1, isRow:=True, _
                          isTrans:=True, CellsResult:=Sheet1.Range("S22"))
    
End Sub
  Function RemoveDupesArray2D(DataArr As Variant, Optional isRow As Boolean = True, _
  Optional NumRC = 1, Optional isTrans As Boolean = False, _
  Optional CellsResult As Range) As Variant
    Dim rArr, iStep&, i&, j&, LA1&, UA1&, LA2&, UA2&, iCol&, iRow&, rRow&, rCol&
    LA1 = LBound(DataArr): UA1 = UBound(DataArr)
    LA2 = LBound(DataArr, 2): UA2 = UBound(DataArr, 2)
    ReDim rArr(IIf(isTrans, LA2, LA1) To IIf(isTrans, UA2, UA1), _
               IIf(isTrans, LA1, LA2) To IIf(isTrans, UA1, UA2))
    LA1 = IIf(isRow, LA1, LA2): UA1 = IIf(isRow, UA1, UA2)
    LA2 = IIf(isRow, LA2, LBound(DataArr)): UA2 = IIf(isRow, UA2, UBound(DataArr))
    With CreateObject("Scripting.Dictionary")
        For i = LA1 To UA1
          iRow = IIf(isRow, i, NumRC): iCol = IIf(isRow, NumRC, i)
          If Not .Exists(DataArr(iRow, iCol)) Then
            iStep = iStep + 1
            For j = LA2 To UA2
              rRow = IIf(isRow, iStep, j): rCol = IIf(isRow, j, iStep)
              rArr(IIf(isTrans, rCol, rRow), IIf(isTrans, rRow, rCol)) = DataArr(IIf(isRow, i, j), IIf(isRow, j, i))
            Next j
            .Item(DataArr(iRow, iCol)) = 1
          End If
        Next
      RemoveDupesArray2D = rArr
    End With
    If Not CellsResult Is Nothing Then
      CellsResult.Parent.Cells(CellsResult.Row, CellsResult.Column) _
      .Resize(IIf(isTrans, rCol, rRow), IIf(isTrans, rRow, rCol)).Value = rArr
    End If
  End Function

Hoàng Nhật Phương · 7/1/19

HeSanbi đã viết:

@Nguyễn Hoàng Oanh Thơ
Code dưới của tôi nâng cấp lại code của @snow25, tăng thêm chút khả năng hữu dụng của Hàm

Sử dụng: Nằm ở sub Test
Diễn giải:
Hàm RemoveDupesArray2D sẽ trả lại kết quả của một mảng phụ thuộc tham số nhập vào:
1. DataArr - Nhập mảng
2. isRow - Lọc theo hàng (True) / cột (False)
3. NumRC - Thứ tự Cột hoặc hàng để lọc dữ liệu trùng
4. isTrans - Chuyển đổi mảng từ dọc sang ngang hoặc ngang sang dọc ( True/ False)
5. CellsResult - Nhập vào một Cells . Hàm sẽ trả kết quả tại Cells này

PHP:

Sub Test_RemoveDupesArray2D()
  Sheet1.Range("A12:AH100").ClearContents
  Dim Arr: Arr = Sheet1.Range("A1:Q2").Value
    Call RemoveDupesArray2D(Arr, NumRC:=2, isRow:=False, _
                          isTrans:=False, CellsResult:=Sheet1.Range("A4"))
     
    Call RemoveDupesArray2D(Arr, NumRC:=2, isRow:=False, _
                          isTrans:=True, CellsResult:=Sheet1.Range("S4"))

    Call RemoveDupesArray2D(Arr, NumRC:=1, isRow:=True, _
                          isTrans:=False, CellsResult:=Sheet1.Range("A22"))
                         
    Call RemoveDupesArray2D(Arr, NumRC:=1, isRow:=True, _
                          isTrans:=True, CellsResult:=Sheet1.Range("S22"))
   
End Sub
  Function RemoveDupesArray2D(DataArr As Variant, Optional isRow As Boolean = True, _
  Optional NumRC = 1, Optional isTrans As Boolean = False, _
  Optional CellsResult As Range) As Variant
    Dim rArr, iStep&, i&, j&, LA1&, UA1&, LA2&, UA2&, iCol&, iRow&, rRow&, rCol&
    LA1 = LBound(DataArr): UA1 = UBound(DataArr)
    LA2 = LBound(DataArr, 2): UA2 = UBound(DataArr, 2)
    ReDim rArr(IIf(isTrans, LA2, LA1) To IIf(isTrans, UA2, UA1), _
               IIf(isTrans, LA1, LA2) To IIf(isTrans, UA1, UA2))
    LA1 = IIf(isRow, LA1, LA2): UA1 = IIf(isRow, UA1, UA2)
    LA2 = IIf(isRow, LA2, LBound(DataArr)): UA2 = IIf(isRow, UA2, UBound(DataArr))
    With CreateObject("Scripting.Dictionary")
        For i = LA1 To UA1
          iRow = IIf(isRow, i, NumRC): iCol = IIf(isRow, NumRC, i)
          If Not .Exists(DataArr(iRow, iCol)) Then
            iStep = iStep + 1
            For j = LA2 To UA2
              rRow = IIf(isRow, iStep, j): rCol = IIf(isRow, j, iStep)
              rArr(IIf(isTrans, rCol, rRow), IIf(isTrans, rRow, rCol)) = DataArr(IIf(isRow, i, j), IIf(isRow, j, i))
            Next j
            .Item(DataArr(iRow, iCol)) = 1
          End If
        Next
      RemoveDupesArray2D = rArr
    End With
    If Not CellsResult Is Nothing Then
      CellsResult.Parent.Cells(CellsResult.Row, CellsResult.Column) _
      .Resize(IIf(isTrans, rCol, rRow), IIf(isTrans, rRow, rCol)).Value = rArr
    End If
  End Function

Xin chào HeSanbi, cảm ơn bạn nhiều ạ.
Nhìn code thấy khiếp quá, khuya về OT test thử rồi thông tin đến bạn sau ạ.

VetMini · 7/1/19

PacificPR đã viết:
Em cũng học theo kiểu của Bạn ý. Hôm trước có Anh nói là học theo kiểu "Tụt từ ngọn xuống gốc" đấy ạ

"Anh" nào vậy? Nếu là tôi xin lỗi, rút lại lời ấy.
Lời nói ấy có lẽ được phán ra trước khi tôi nghiệm được cái chân lý rằng ở diễn đàn này chả có "ngọn" và "gốc" gì cả.

tam888 đã viết:
Học kiểu đó , cảm giác nhanh có ích
nhưng động vào code bài khác khác kiểu đã biết, là dễ tẩu hỏa
Tuy thế cũng có nhiều người có đầu óc nhanh nhạy và thích ứng tốt - và thành công

Thời buổi công nghệ thông tin súp pưo hai quê, "tẩu hoả" chả sao cả. Chỉ việc đem cái "bài khác khác kiểu đã biết" lên đây hỏi. Sẽ có người giải quyết cho.

Và "thành công" chả liên quan gì đến học cốt kiếc. Bất cứ điều gì cũng có thể lên diễn đàn mà hỏi.
Tôi đã từng thấy một cái pơ rô dét to tổ bố nhờ ở đây cốt từ A đến Z.

batman1 · 7/1/19

VetMini đã viết:
"Anh" nào vậy? Nếu là tôi xin lỗi, rút lại lời ấy.
Lời nói ấy có lẽ được phán ra trước khi tôi nghiệm được cái chân lý rằng ở diễn đàn này chả có "ngọn" và "gốc" gì cả.

Thời buổi công nghệ thông tin súp pưo hai quê, "tẩu hoả" chả sao cả. Chỉ việc đem cái "bài khác khác kiểu đã biết" lên đây hỏi. Sẽ có người giải quyết cho.

Và "thành công" chả liên quan gì đến học cốt kiếc. Bất cứ điều gì cũng có thể lên diễn đàn mà hỏi.
Tôi đã từng thấy một cái pơ rô dét to tổ bố nhờ ở đây cốt từ A đến Z.

Thời buổi này ăn nhau là biết cách "tìm kiếm" thông tin ... trên google.
Và biết cách sử dụng, ghép các "mẩu" thông tin với nhau. Được thế thì cứ thỉnh thoảng lại "cưỡi" Mada mới.

tam888 · 8/1/19

VetMini đã viết:
"Anh" nào vậy? Nếu là tôi xin lỗi, rút lại lời ấy.
Lời nói ấy có lẽ được phán ra trước khi tôi nghiệm được cái chân lý rằng ở diễn đàn này chả có "ngọn" và "gốc" gì cả.

Thời buổi công nghệ thông tin súp pưo hai quê, "tẩu hoả" chả sao cả. Chỉ việc đem cái "bài khác khác kiểu đã biết" lên đây hỏi. Sẽ có người giải quyết cho.

Và "thành công" chả liên quan gì đến học cốt kiếc. Bất cứ điều gì cũng có thể lên diễn đàn mà hỏi.
Tôi đã từng thấy một cái pơ rô dét to tổ bố nhờ ở đây cốt từ A đến Z.

Ah, đó là nói chung cho những người chot dại đam mê code và cái diễn đàn này...

Còn nhanh nhạy là nhờ nhanh, lật nhanh ... thì thành công đi 4 bánh

Hoàng Nhật Phương · 9/2/19

Xin chào các bạn,
Nhờ các bạn giúp đỡ Oanh Thơ trường hợp tìm ngày giờ lớn nhất trong mảng dữ liệu theo file gửi kèm với ạ.

Ba Tê · 9/2/19

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào các bạn,
Nhờ các bạn giúp đỡ Oanh Thơ trường hợp tìm ngày giờ lớn nhất trong mảng dữ liệu theo file gửi kèm với ạ.

View attachment 212006

Code viết theo "y chang" dữ liệu của bạn, không "bảo hành" với dữ liệu kiểu "nếu...".
Ô H2 format kiểu gì tùy bạn.

PHP:

Option Explicit

Public Sub sGpe()
Dim sArr(), I As Long, R As Long, Txt As String, Tem As Double, KQ As Double
sArr = Range("C1", Range("C1").End(xlDown)).Value
R = UBound(sArr)
For I = 1 To R
    If sArr(I, 1) Like "Ngay Gio:*" Then
        Txt = Right(sArr(I, 1), 16)
        Tem = DateSerial(Mid(Txt, 7, 4), Mid(Txt, 4, 2), Left(Txt, 2)) + TimeSerial(Mid(Txt, 12, 2), Right(Txt, 2), 0)
        If Tem > KQ Then KQ = Tem
    End If
Next I
Range("H2") = KQ
End Sub

Hoàng Nhật Phương · 9/2/19

Ba Tê đã viết:
Code viết theo "y chang" dữ liệu của bạn, không "bảo hành" với dữ liệu kiểu "nếu...".
Ô H2 format kiểu gì tùy bạn.

PHP:

Option Explicit Public Sub sGpe() Dim sArr(), I As Long, R As Long, Txt As String, Tem As Double, KQ As Double sArr = Range("C1", Range("C1").End(xlDown)).Value R = UBound(sArr) For I = 1 To R If sArr(I, 1) Like "Ngay Gio:*" Then Txt = Right(sArr(I, 1), 16) Tem = DateSerial(Mid(Txt, 7, 4), Mid(Txt, 4, 2), Left(Txt, 2)) + TimeSerial(Mid(Txt, 12, 2), Right(Txt, 2), 0) If Tem > KQ Then KQ = Tem End If Next I Range("H2") = KQ End Sub

Xin chào Thầy Ba Tê:
Con cảm ơn Thầy đã giúp đỡ ạ, code trên của Thầy con ứng dụng OK rồi ạ.
Thầy và các bạn cho OT hỏi thêm trong trường hợp dữ liệu là:
Ngay Gio: 21/1/2019 06:00 giống với kiểu định dạng "Ngay Gio: "d/m/yyyy hh:mm.
Thì code trên sẽ viết như thế nào để có thể sử dụng được mà không phải sửa tay các con số trong hàm Mid ạ.

VetMini · 9/2/19

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào Thầy Ba Tê:
Con cảm ơn Thầy đã giúp đỡ ạ, code trên của Thầy con ứng dụng OK rồi ạ.
Thầy và các bạn cho OT hỏi thêm trong trường hợp dữ liệu là:
Ngay Gio: 21/1/2019 06:00 giống với kiểu định dạng "Ngay Gio: "d/m/yyyy hh:mm.
Thì code trên sẽ viết như thế nào để có thể sử dụng được mà không phải sửa tay các con số trong hàm Mid ạ.

Yêu cầu của bạn đòi hỏi phải chuẩn hóa ngày. Cách ít phiền phức nhất là dùng một hàm chuẩn hóa ngày về dạng "universal" - tức là dạng yyyy/mm/dd hoặc yyyy-mm-dd

Bên thớt "Những câu hỏi về lập trình..." tôi có giới thiệu sơ qua về cái hàm chuyển đổi dạng chuẩn này.
Công việc của bạn là sửa code ở bài #1129 như sau:
1. Dùng hàm Replace để biến "Ngay Gio:" thành "", và Trim
2. Dùng hàm Split theo " " để lấy phần ngày ở đầu
3. Dùng hàm UniversalDate để đổi phần tử đầu (chỉ số 0) thành dạng yyyy/mm/dd - vì ở đây bạn có sẵn dạng dd/mm/yyyy cho nên tham thứ hai nạp cho hàm UniversalDate là "EU"
4. Dùng hàm Join để join lại theo " "
5. Bây giờ Txt là dạng ngày giờ chuẩn cho nên bạn có thể giản dị dùng hàm CDate để đổi nó thành ngày giờ.

Function UniversalDate(ByVal d As String, Optional inTyp As String = "US") As String
' function to change date string from dd/mm/yyyy (inTyp = "EU"), or mm/dd/yyyy (inTyp="US") to yyyy/mm/dd
Dim x() As String
x = Split(d, "/")
If Len(x(2)) < 4 Then x(2) = CStr(2000 + Val(x2)) ' normalise year
If UCase(inTyp) = "US" Then
UniversalDate = x(2) & "/" & x(0) & "/" & x(1)
Else
UniversalDate = x(2) & "/" & x(1) & "/" & x(0)
End If
End Function

Hoàng Nhật Phương · 9/2/19

VetMini đã viết:
Yêu cầu của bạn đòi hỏi phải chuẩn hóa ngày. Cách ít phiền phức nhất là dùng một hàm chuẩn hóa ngày về dạng "universal" - tức là dạng yyyy/mm/dd hoặc yyyy-mm-dd

Bên thớt "Những câu hỏi về lập trình..." tôi có giới thiệu sơ qua về cái hàm chuyển đổi dạng chuẩn này.
Công việc của bạn là sửa code ở bài #1129 như sau:
1. Dùng hàm Replace để biến "Ngay Gio:" thành "", và Trim
2. Dùng hàm Split theo " " để lấy phần ngày ở đầu
3. Dùng hàm UniversalDate để đổi phần tử đầu (chỉ số 0) thành dạng yyyy/mm/dd - vì ở đây bạn có sẵn dạng dd/mm/yyyy cho nên tham thứ hai nạp cho hàm UniversalDate là "EU"
4. Dùng hàm Join để join lại theo " "
5. Bây giờ Txt là dạng ngày giờ chuẩn cho nên bạn có thể giản dị dùng hàm CDate để đổi nó thành ngày giờ.

Function UniversalDate(ByVal d As String, Optional inTyp As String = "US") As String
' function to change date string from dd/mm/yyyy (inTyp = "EU"), or mm/dd/yyyy (inTyp="US") to yyyy/mm/dd
Dim x() As String
x = Split(d, "/")
If Len(x(2)) < 4 Then x(2) = CStr(2000 + Val(x2)) ' normalise year
If UCase(inTyp) = "US" Then
UniversalDate = x(2) & "/" & x(0) & "/" & x(1)
Else
UniversalDate = x(2) & "/" & x(1) & "/" & x(0)
End If
End Function

Cảm ơn Bác VetMini nhiều ạ,
Cháu sẽ thử làm theo 5 bước trên nếu gặp khó khăn rất mong lại nhận được sự giúp đỡ của Bác và mọi người ạ.
-----
Nhân dịp đầu xuân cháu kinh chúc Bác cùng gia đình một năm mới An Khang Thịnh Vượng, Vạn Sự Như Ý.

SA_DQ · 9/2/19

Mà sao CSDL lài có kiểu Ngay Gio: 14/12/2018 18:04 hay vậy ta?
Kiểu này nên chuyển sang xài Words, sẽ êm ngay tấp lự!

Riết rồi các thợ nhà ta chuyên đi gom & phân loại rác!

HeSanbi · 9/2/19

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào các bạn,
Nhờ các bạn giúp đỡ Oanh Thơ trường hợp tìm ngày giờ lớn nhất trong mảng dữ liệu theo file gửi kèm với ạ.

Nguyễn Hoàng Oanh Thơ đã viết:
Ngay Gio: 21/1/2019 06:00 giống với kiểu định dạng "Ngay Gio: "d/m/yyyy hh:mm.
Thì code trên sẽ viết như thế nào để có thể sử dụng được mà không phải sửa tay các con số trong hàm Mid ạ.

Đơn giản là:
Chỉ cần bỏ đi "Ngay Gio: " nếu gặp. Rồi chuyển nó thành thời gian theo định dạng.
So sánh biến đại diện thời gian lớn nhất với nó. Nếu lớn hơn thì cho biến này thành nó

Code dưới tôi chưa kiểm thử (Thang siêng năng của tôi = 1/10, sympathize for me)

PHP:

Sub test_date()
  Dim Arr(), DArr$(), i&, M#, Str$, D#, DStr$
  With Sheets(1)
    Arr = .Range("C1", .Range("C1").End(xlDown)).Value
    For i = 1 To UBound(Arr)
      If Arr(i, 1) Like "Ngay Gio:*/*/*:*" Then
        Str = Replace(Arr(i, 1), "Ngay Gio: ", "")
        DStr = Left(Str, Len(Str) - 5)
        DArr = Split(DStr, "/")
        D = DateSerial(DArr(2), DArr(1), DArr(0)) + TimeValue(Right(Str, 5))
        M = IIf(D > M, D, M)
      End If
    Next i
    .Range("H2").Value = M
    .Range("H2").NumberFormat = "d/m/yyyy hh:mm"
  End With
End Sub

Code này lấy toàn bộ giá trị lớn nhất gồm "Ngay Gio: ":

PHP:

Sub test_date1()
  Dim Arr(),DArr$(), i&, M#, D#, MStr$, Str$
  With Sheets(1)
    Arr = .Range("C1", .Range("C1").End(xlDown)).Value
    For i = 1 To UBound(Arr)
      If Arr(i, 1) Like "Ngay Gio:*/*/*:*" Then
        Str = Replace(Arr(i, 1), "Ngay Gio: ", "")
        DStr = Left(Str, Len(Str) - 5)
        DArr = Split(DStr, "/")
        D = DateSerial(DArr(2), DArr(1), DArr(0)) + TimeValue(Right(Str, 5))
        If (D > M) Then M = D: MStr = Arr(i, 1)
      End If
    Next i
    .Range("H2").Value = MStr
  End With
End Sub

VetMini · 9/2/19

HeSanbi đã viết:
Đơn giản là:
Chỉ cần bỏ đi "Ngay Gio: " nếu gặp. Rồi chuyển nó thành thời gian bằng hàm CDate.
...

Đơn giản nhất và cũng là phương pháp NGUY HIỂM nhất.
Hàm CDate dựa trên mặc định máy để hiểu đầu vào là dạng dd/mm hay mm/dd. Tuy nhiên, nếu thấy tháng lớn hơn 12 thì nó sẽ tự động chuyển bên này sang bên kia. Cuối cùng sẽ nhận được một kết quả mà mình cũng chả biết là đúng hay sai.

CDate("31/01/2019") và CDate("01/31/2019") đều ra ngày 31 tháng Giêng 2019. Không tùy thuộc hệ thống.

(*) chịu khó đọc bài bên "giải đáp thắc mắc về code...", các bài ngày 07/02/2019 có giải thích rõ hơn về mặc định ngày tháng này.

HeSanbi · 9/2/19

@Nguyễn Hoàng Oanh Thơ

Nếu CDate bó tay thì dùng "Spring Date"

PHP:

Sub test_date()
  Dim Arr(), DArr$(), i&, M#, Str$, D#, DStr$
  With Sheets(1)
    Arr = .Range("C1", .Range("C1").End(xlDown)).Value
    For i = 1 To UBound(Arr)
      If Arr(i, 1) Like "Ngay Gio:*/*/*:*" Then
        Str = Replace(Arr(i, 1), "Ngay Gio: ", "")
        DStr = Left(Str, Len(Str) - 5)
        DArr = Split(DStr, "/")
        D = DateSerial(DArr(2), DArr(1), DArr(0)) + TimeValue(Right(Str, 5))
        M = IIf(D > M, D, M)
      End If
    Next i
    .Range("H2").Value = M
    .Range("H2").NumberFormat = "d/m/yyyy hh:mm"
  End With
End Sub
Sub test_date1()
  Dim Arr(),DArr$(), i&, M#, D#, MStr$, Str$
  With Sheets(1)
    Arr = .Range("C1", .Range("C1").End(xlDown)).Value
    For i = 1 To UBound(Arr)
      If Arr(i, 1) Like "Ngay Gio:*/*/*:*" Then
        Str = Replace(Arr(i, 1), "Ngay Gio: ", "")
        DStr = Left(Str, Len(Str) - 5)
        DArr = Split(DStr, "/")
        D = DateSerial(DArr(2), DArr(1), DArr(0)) + TimeValue(Right(Str, 5))
        If (D > M) Then M = D: MStr = Arr(i, 1)
      End If
    Next i
    .Range("H2").Value = MStr
  End With
End Sub

Hoàng Nhật Phương · 9/2/19

SA_DQ đã viết:
Mà sao CSDL lài có kiểu Ngay Gio: 14/12/2018 18:04 hay vậy ta?
Kiểu này nên chuyển sang xài Words, sẽ êm ngay tấp lự!

Riết rồi các thợ nhà ta chuyên đi gom & phân loại rác!

Cảm ơn bác SA_DQ đã quan tâm ạ, có thể bác không tin nhưng CSDL kiểu đó lại chính là dữ liệu xuất ra từ phần mềm.
Những chỗ không liên quan(không cần thiết) nên Oanh Thơ đã thay bằng dữ liệu minh họa.
----------

HeSanbi đã viết:

@Nguyễn Hoàng Oanh Thơ

Nếu CDate bó tay thì dùng "Spring Date"

PHP:

Sub test_date()
  Dim Arr(), DArr(), i&, M#, Str$, D#, DStr$
  With Sheets(1)
    Arr = .Range("C1", .Range("C1").End(xlDown)).Value
    For i = 1 To UBound(Arr)
      If Arr(i, 1) Like "Ngay Gio:*/*/*:*" Then
        Str = Replace(Arr(i, 1), "Ngay Gio: ", "")
        DStr = Left(Str, Len(Str) - 5)
        DArr = Split(DStr, "/")
        D = DateSerial(DArr(2), DArr(1), DArr(0)) + TimeValue(Right(Str, 5))
        M = IIf(D > M, D, M)
      End If
    Next i
    .Range("H2").Value = M
    .Range("H2").NumberFormat = "d/m/yyyy hh:mm"
  End With
End Sub
Sub test_date1()
  Dim Arr(),DArr(), i&, M#, D#, MStr$, Str$
  With Sheets(1)
    Arr = .Range("C1", .Range("C1").End(xlDown)).Value
    For i = 1 To UBound(Arr)
      If Arr(i, 1) Like "Ngay Gio:*/*/*:*" Then
        Str = Replace(Arr(i, 1), "Ngay Gio: ", "")
        DStr = Left(Str, Len(Str) - 5)
        DArr = Split(DStr, "/")
        D = DateSerial(DArr(2), DArr(1), DArr(0)) + TimeValue(Right(Str, 5))
        If (D > M) Then M = D: MStr = Arr(i, 1)
      End If
    Next i
    .Range("H2").Value = MStr
  End With
End Sub

Xin chào HeSanbi,
Cảm ơn bạn nhiều, các code trên đều bị lỗi "Type mismatch" tại dòng: DArr = Split(DStr, "/").
Nhờ bạn xem giúp.

SA_DQ · 9/2/19

bác SA_DQ ạ, nhưng CSDL kiểu đó lại chính là dữ liệu xuất ra từ phần mềm.
Những chỗ không liên quan(không cần thiết) nên Oanh Thơ đã thay bằng dữ liệu minh họa..

Vậy trước khi xử lý hay tính toán tiếp, ta làm 1 macro xử lý đưa về thành dữ liệu chuẩn hơn, được không?

Các câu hỏi về mảng trong VBA (Array)

Thành viên gắn bó

Thành viên mới

Thành viên gạo cội

Thành viên tích cực

Thành viên gắn bó

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên gắn bó

Ăn cùng góc phố

Thành viên gạo cội

Thành viên tích cực

Thành viên gắn bó

File đính kèm

Cạo Rồi Khỏi Gội

Thành viên gắn bó

Ăn cùng góc phố

Thành viên gắn bó

/(hông là gì!

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Ăn cùng góc phố

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên gắn bó

/(hông là gì!

Đếm ngược thời gian