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

Liên hệ QC
viehoai

viehoai

Thành viên gắn bó
Tham gia
22/5/09
Bài viết
2,600
Được thích
2,907
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ị
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
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 ạ
Nhấp chuột vào đây để mở rộng...
Học kiểu đó , cảm giác nhanh có ích
nhưng động vào code bài khác khác kiểu đã biết, là dễ tẩu hỏa
Tuy thế cũng có nhiều người có đầu óc nhanh nhạy và thích ứng tốt - và thành công
 
Upvote 0
tam888 đã viết:
Đề nghị OanhTho phải đọc lại VBA từ Cơ bản
Tôi cảm thấy bạn học từ diễn đàn này lung tung quá - nói khác là học từ giữa ra hay cao xuống thì phải --- Nếu không phải thì bỏ qua, coi như tôi chưa viết.

So ở đây là tham số - bạn phải đọc code của họ thì sẽ hiểu so là gì --> so chính là thứ tự cột xét trùng (với code gốc bạn tham chiếu từ website của tây nhé) -- các codes sửa lại chỉnh lý sau thì tương tự, chỉ riêng với dk=2 thì lúc này so lại là thứ tự dòng (ở đây =1 luôn, vì họ chỉ xét mảng có một dòng A#:Q#)
Nên có thể người ta thích cột xét trùng là cột khác
Lưu ý hàm tẩy (remove ...:D ) trùng RemoveDupesDict ở đây chỉ xét 1 cột trùng của bảng MyArray
Nhấp chuột vào đây để mở rộng...


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

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 ạ.
 
Upvote 0
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 ạ
Nhấp chuột vào đây để mở rộng...
"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:
Học kiểu đó , cảm giác nhanh có ích
nhưng động vào code bài khác khác kiểu đã biết, là dễ tẩu hỏa
Tuy thế cũng có nhiều người có đầu óc nhanh nhạy và thích ứng tốt - và thành công
Nhấp chuột vào đây để mở rộ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.
 
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
Thời buổi này ăn nhau là biết cách "tìm kiếm" thông tin ... trên google.
Và biết cách sử dụng, ghép các "mẩu" thông tin với nhau. Được thế thì cứ thỉnh thoảng lại "cưỡi" Mada mới. :D
 
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
Ah, đó là nói chung cho những người chot dại đam mê code và cái diễn đàn này...

Còn nhanh nhạy là nhờ nhanh, lật nhanh ... thì thành công đi 4 bánh
 
Upvote 0
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 ạ.



Untitled.png
 

File đính kèm

  • Book10.xlsx
    23.3 KB · Đọc: 13
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...

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

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ư Ý.
 
Upvote 0
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!
 
Upvote 0
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 ạ.
Nhấp chuột vào đây để mở rộng...
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 ạ.
Nhấp chuột vào đây để mở rộng...

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

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

H
  • Question
Code VBA cho kết quả dòng, cột theo điều kiện từ 2 Sheets
Trả lời
3
Đọc
79
hieuvietmy2020
H
NguyenthiH
  • Question
Code lấy dữ liệu cho sheet!TonDau.
Trả lời
3
Đọc
71
HUONGHCKT
H
C
  • Question
Ứng dụng quản lý thu chi đơn giản viết bằng VBA
    • Thích
    • Yêu thích
Trả lời
6
Đọc
395
chstbcaolanh
C
Tienvinh191
  • Question
Nhờ viết Code lấy dữ liệu tờ khai hải quan vào bảng tổng hợp
2
Trả lời
23
Đọc
621
huevantran
huevantran
S
  • Question
nhờ viết code chuyển file excel sang file mẫu .txt
Trả lời
2
Đọc
119
soap1234
S
Xem thêm…

Facebook

Giaiphapexcel.com

Group

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

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