Các câu hỏi về Create Object (1 người xem)

[nmhung49]

Trong quá trình nghiên cứu về Create Object mình thấy nó rất hay nhưng chưa hiểu hết ý nghĩa của nó. Hôm nay mình xin mở chủ đề này để tập hợp các câu lệnh về Create Object để hiểu rõ hơn về ý nghĩa của nó. Mình xin nổ phát súng đầu tiên về CreateObject("Scripting.Dictionary"). Mình thấy chức năng này rất hay trong lấy dữ liệu duy nhất. Mong các bạn, Anh Chị giúp đỡ để chủ đề sôi nổi hơn. Có gì sai xót xin các Bạn và Anh Chị bỏ qua

Sub copyunique()
Dim sArr, Arr() As String, Li As Long, item 'khai bao bien can thiet
sArr = Sheets("sheet1").Range([A2], [A65000].End(xlUp)).Value 'gan vung du lieu vao mang
ReDim Arr(1 To UBound(sArr, 1), 1 To LBound(sArr, 1)) 'thay doi kich  thuoc mang
With CreateObject("Scripting.Dictionary") 'tao dic
    For Each item In sArr 'duyet cac item trong sarr
        If Not .exists(item) Then 'xem xet coi cac item co ton tai trong dic khong
            Li = Li + 1
            .Add item, ""   'add cac item do vao dic
            Arr(Li, 1) = item   'gan item du lieu can lay vao arr
        End If
    Next
End With
Sheets("sheet1").Range("d2").Resize(UBound(Arr)) = Arr 'lay du lieu co trong arr ra
End Sub

Mình có giải thích các câu lệnh không biết có đúng không nữa giải thích đại theo mình hiểu ặc...ặc.... Vậy cho mình hỏi nếu lấy dữ liệu trùng và duy nhất thì làm sao???
Bạn tham khảo thêm về mảng tại đây http://www.giaiphapexcel.com/forum/showthread.php?46834-Các-câu-hỏi-về-mảng-trong-VBA-(Array)

 

[ndu96081631]

Vậy cho mình hỏi nếu lấy dữ liệu trùng và duy nhất thì làm sao???

Code trên là lấy dữ liệu duy nhất rồi còn gì

 

[nmhung49]

Code trên là lấy dữ liệu duy nhất rồi còn gì

Không phải anh Ndu mình lấy dự liệu trùng thôi đó mà

 

[ndu96081631]

Không phải anh Ndu mình lấy dự liệu trùng thôi đó mà

Tức là sao? Có trùng thì mới lấy, không trùng thì bỏ qua, đúng không?
trong khi chờ bạn trả lời, tôi xin góp ý về code trên
sArr = Sheets("sheet1").Range([A2], [A65000].End(xlUp)) ---> Viết vầy là không đúng (cell A2 và A65536 bạn không ghi rõ thuộc sheet nào) ---> phải thế này:
sArr = Sheets("sheet1").Range(Sheets("sheet1").[A2], Sheets("sheet1").[A65000].End(xlUp))
Hoặc cách khác:

With Sheets("sheet1")
  sArr = .Range(.[A2], .[A65000].End(xlUp)).Value
End With

ReDim Arr(1 To UBound(sArr, 1), 1 To LBound(sArr, 1)) ---> Chẳng ổn tí nào, ít ra cũng phải thế này:
ReDim Arr(1 To UBound(sArr, 1), 1 To UBound(sArr, 2))
Hoặc đơn giản
ReDim Arr(1 To UBound(sArr, 1), 1 To 1)
If Not .exists(item) ---> Nếu item = "" thì lấy luôn à?
Sheets("sheet1").Range("d2").Resize(UBound(Arr)) = Arr ---> Thay UBound(Arr) bằng Li cũng được vậy
--------------------
Tóm lại tôi viết thế này:

Sub copyunique()
  Dim sArr, Arr() As String, Li As Long, item
  With Sheets("sheet1")
    sArr = .Range(.[A2], .[A65000].End(xlUp)).Value
    ReDim Arr(1 To UBound(sArr, 1), 1 To 1)
    With CreateObject("Scripting.Dictionary")
      For Each item In sArr
        If item <> "" Then
          If Not .exists(item) Then
            Li = Li + 1
            .Add item, ""
            Arr(Li, 1) = item
          End If
        End If
      Next
    End With
    .Range("D2").Resize(Li) = Arr
  End With
End Sub

(cái tên biến Li nhìn... khó coi quá ---> Đặt lR dễ hiểu hơn: l ý nói thuộc biến Long và R là chỉ số dòng ROW)

 

[nmhung49]

Tức là sao? Có trùng thì mới lấy, không trùng thì bỏ qua, đúng không?

Đúng vậy đó anh Ndu

ReDim Arr(1 To UBound(sArr, 1), 1 To LBound(sArr, 1)) ---> Chẳng ổn tí nào, ít ra cũng phải thế này:

Cái này bị lộn, khi viết em không để ý ặc...ặc..

ReDim Arr(1 To UBound(sArr, 1), 1 To 1)

Em đang tập viết nên viết vậy cho nó quen vậy mà

(cái tên biến Li nhìn... khó coi quá ---> Đặt lR dễ hiểu hơn: l ý nói thuộc biến Long và R là chỉ số dòng ROW)

Làm như thế thì chuyên nghiệp hơn mà em không chuyên nên bị vậy mà thường ngày khai báo biến vậy riết quen

 

[ndu96081631]

Đúng vậy đó anh Ndu

Tức hể thấy item nào bị trùng thì mới lấy và cũng chỉ lấy duy nhất 1 lần, đúng không
Code này xem:

Sub copyunique()
  Dim sArr, Arr() As String, lR As Long, item
  With Sheets("sheet1")
    sArr = .Range(.[A2], .[A65000].End(xlUp)).Value
    ReDim Arr(1 To UBound(sArr, 1), 1 To 1)
    With CreateObject("Scripting.Dictionary")
      For Each item In sArr
        If item <> "" Then
          If Not .exists(item) Then
            .Add item, 1 '<--- đánh dấu số 1 vào item
          Else
            If .item(item) = 1 Then
              lR = lR + 1
              Arr(lR, 1) = item
              .item(item) = .item(item) + 1 '<--- cộng thêm 1 vào item để biết lần sau khỏi lấy nữa
            End If
          End If
        End If
      Next
    End With
    If lR > 0 then .Range("d2").Resize(lR) = Arr
  End With
End Sub

 

[huuthang_bd]

Tức hể thấy item nào bị trùng thì mới lấy và cũng chỉ lấy duy nhất 1 lần, đúng không
Code này xem:

Sub copyunique()
  Dim sArr, Arr() As String, lR As Long, item
  With Sheets("sheet1")
    sArr = .Range(.[A2], .[A65000].End(xlUp)).Value
    ReDim Arr(1 To UBound(sArr, 1), 1 To 1)
    With CreateObject("Scripting.Dictionary")
      For Each item In sArr
        If item <> "" Then
          If Not .exists(item) Then
            .Add item, 1 '<--- đánh dấu số 1 vào item
          Else
            If .item(item) = 1 Then
              lR = lR + 1
              Arr(lR, 1) = item
              .item(item) = .item(item) + 1 '<--- cộng thêm 1 vào item để biết lần sau khỏi lấy nữa
            End If
          End If
        End If
      Next
    End With
    If lR > 0 then .Range("d2").Resize(lR) = Arr
  End With
End Sub

Trong câu lệnh này:

.item(item) = [COLOR=#ff0000][B].item(item) + 1[/B][/COLOR]

Đoạn in đậm chắc chắn bằng 2. Sao anh không để số 2 vào luôn cho khỏe.

 

[ndu96081631]

Trong câu lệnh này:

.item(item) = [COLOR=#ff0000][B].item(item) + 1[/B][/COLOR]

Đoạn in đậm chắc chắn bằng 2. Sao anh không để số 2 vào luôn cho khỏe.

Ẹc... Ẹc... tại... quen tật!

 

[nmhung49]

Tiếp theo mình xin giới thiệu về chứa năng gọi ứng dụng dựa vào CreateObject("Shell.Application")
Dựa vào Shell Funtion

Sub callprogram()
Shell "winword.exe " & "D:\New.doc", vbNormalFocus ' Thay the "D:\New.doc" bang duong dan thich hop
End Sub

Dựa vào CreateObject("Shell.Application")

Sub callprogram1()
With CreateObject("Shell.Application")
 .Open ("D:\New.doc")
End With
End Sub

Giữa shell function và CreateObject("Shell.Application") thì mình thấy CreateObject nó thiệt lợi hơn muốn gọi chương trình gì cũng được. Vậy cho hỏi mình còn bao nhiều cách gọi chương trinh khác từ excel ra
Tham khảo từ bài này http://www.giaiphapexcel.com/forum/showthread.php?23619-Code-mở-file-*.chm&
và bài này http://www.giaiphapexcel.com/forum/showthread.php?29097-Sử-dụng-lệnh-Shell&

 

[ndu96081631]

Tiếp theo mình xin giới thiệu về chứa năng gọi ứng dụng dựa vào CreateObject("Shell.Application")

Bài trước ta đang bàn về Dictionary, nó thuộc Microsoft Scripting Runtime. Ngoài Dictionary ra còn có FileSystemObject cũng có nhiều ứng dụng hay, nhất là những thứ liên quan đến xử lý file và thư mục
Vậy sao không làm tiếp luôn về Scripting Runtime, chuyển qua phần khác làm gì vội?

 

[ndu96081631]

Bàn tiếp về Scripting Runtime - FileSystemObject. Ta thí nghiệm như sau:
- Mở Excel
- Alt + F11 vào cửa số code, chèn 1 Module
- Vào menu Tools\Preferences và check mục Microsoft Scripting Runtime



- trong module, viết code thế này

Sub Test()
  With New Scripting.FileSystemObject
    
  End With
End Sub

- Ở giữa With... End With, hãy gõ dấu chấm vào, sẽ thấy 1 tooltip hiện ra



- Nghiên cứu từng phương thức (hoặc thuộc tính) của FileSystemObject xem nó làm cái gì
-----------------------
Cũng rất dễ hiểu, vì nếu biết tiếng Anh sẽ đoán được mục đích thông qua tên của phương thức (hoặc thuộc tính)

 

[nmhung49]

Tiếp theo ta sẽ tiếp tục tao file bằng FileSystemObject

Sub filesys()
Dim fso As Object, fle
Set fso = CreateObject("scripting.FileSystemObject")
Set fle = fso.CreatetextFile("D:\GPE_new.txt", True)
End Sub

Ta biết Createtextfile chỉ tạo được file có đuôi txt thôi nếu ta đổi thành đuôi xls, xlsx vẫn được nhưng khi mở sẽ báo lỗi vậy có cách nào tạo file xls, xlsx bằng FileSystemObject. Đọc help mà không thấy mong anh chị giúp
Thường thì em tạo bằng đoạn code này, đơn giản hơn dùng record macro

Sub filesys1()
Dim excelapp As Excel.Application, excelwb As Workbook
Set excelapp = CreateObject("Excel.Application")
Set excelwb = excelapp.Workbooks.Add
With excelwb
.SaveAs "D:\Book3.xlsx"
.Close
End With
End Sub

Mong anh chị chỉ giúp. Thanks

 

[Nguyễn Duy Tuân]

Hàm Shell và hàm CreateObject khác nhau bạn à.

Hàm Shell để gọi một ứng dụng, chạy theo cơ chế HĐH gọi trong Explorer.
Shell "powerpnt.exe"
Shell "winword.exe"
Shell "excel.exe"
Shell "calc.exe"
Shell "mspaint.exe"

....

Còn hàm CreateObject là khởi tạo một đối tượng/Object đúng theo nghĩa của nó. Các đối tượng được tạo ra trong một thư viện nào đó, thư viện là các file ocx, dll, exe. Sau khi tạo đối tượng, ta có thể khai thác các thành phần của đối tượng này.

Cấu trúc hàm:

Function CreateObject(class,[servername]) As Object

class: là tên của lớp đối tượng

Ví dụ Excel.Application ==> "Excel" là tên thư viện chứa class "Application". Khi ta gọi thường chỉ ra tên đầy đủu TenThuVien.TenCLASS

Trong Winword có một đối tượng/Class là Application nên nếu ta muốn tạo đối tượng này thì cần viết lệnh
Set objWord = CreateObject("Word.Application") '-- "Word" là tên thư viện

servername: là tên hoặc địa chỉ IP của máy chứa Class hay thư viện. Nếu không chỉ ra tên máy chủ, VBA tự lấy tên hay IP của máy tính đang gọi nó. Phần lớn ta không dùng tham số này. Nhưng khi dùng thì rất đặc biệt. Giả sử ta mua bản quyền và chỉ cài vào cho một máy chủ, các máy khác có thể tạo đối tượng từ xa. Ví dụ tạo ứng tụ Word mà thư viện lấy từ máy chủ của Bluesofts
Set objWord = CreateObject("Word.Application, "www.bluesofts.net") '-- Tên máy chủ có thể làddiacj chỉ mạng, tên miền, tên máy chủ.

Ví dụ dưới đây là từ Excel tạo ứng dụng Word, sau đó tạo file văn bản và thêm đoạn "Nhap du lieu tu Excel =>> Word."

Sub OpenWinword()
Dim objWord As Object
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Documents.Add
objWord.ActiveDocument.Range.Text = "Nhap du lieu tu Excel =>> Word."
Set objWord = Nothing
End Sub


Ví dụ mở Powerpoint

Sub OpenPowerPoint()
Dim objPPT As Object
Set objPPT = CreateObject("Powerpoint.Application")
objPPT.Visible = True
objPPT.Presentations.Add
objPPT.ActivePresentation.TitleMaster.Shapes(1).TextFrame.TextRange.Text = "Nhap du lieu tu Excel =>> PowerPoint."
Set objPPT = Nothing
End Sub

Như vậy khi đã tạo được Object thì ta có thể khai tác các thành phần của Object đó. Từ một macro tôi có thể ghi và nhận dữ liệu giữa các phần mềm của Microsoft Office, tôi có thể mở bản nhạc trên Window Media, có thể lấy dữ liệu từ bảng tính Excel, mở AutoCad vẽ một hình tròn,....

Muốn biết các thành phần có thể dùng trong Class thì hãy Reference và tìm tới thư viện DLL, EXE hoặc OCX (Phần lớn chúng nằm trong C:\Windows\System32)

Tất cả các phần mềm, các thư viện có Class thì ta có thể dùng CreateObject để khởi tạo và khai thác chúng. Nếu không dùng hàm CreateObject thì ta phải Reference tới thư viện chứa các Class.

Các code lập trình ADO, thường chúng ta dùng phương pháp Reference tới thư viện "Microsoft ActiveX Data Objects x.x" và trong code ta khai báo

Dim cnn As ADODB.Connection

Để khởi tạo dùng lệnh

Set cnn = New ADODB.Connection

Từ đây ta có thể dùng các thành phần của class Connection thông qua biến cnn

cnn.Open("...")


Nếu không dùng kiểu tham chiếu Reference (không cần nhúng thư viện vào file), ta dùng CreateObject như sau

Dim cnn As Object

Để khởi tạo dùng lệnh

Set cnn = CreateObject("ADODB.Connection") '----Thay cho lệnh Set cnn = New ADODB.Connection

Vấn đề này tương đối dài dòng, liên quan tới các kiến thức về đối tượng/Class, Automation. Tạm thời tôi giả thích qua như vậy hy vọng một dịp khác nói cụ thể hơn.

 

[nmhung49]

Nhân việc nghiên cứu Method Keys mình xin bổ sung cách lấy dữ liệu duy nhất ở bài #1, 1 cách rút gọn hơn

Sub copyunique()
 Dim sArr, item 'khai bao bien can thiet
 With Sheets("sheet1")
    sArr = .Range(.[A2], .[A65000].End(xlUp)).Value 'gan vung du lieu vao mang
 End With
  With CreateObject("Scripting.Dictionary") 'tao dic
    For Each item In sArr 'duyet cac item trong sarr
        If item <> "" Then
            If Not .exists(item) Then 'xem xet coi cac item co ton tai trong dic khong                
                .Add item, ""   'add cac item do vao dic                
            End If
        End If
    Next
Sheets("sheet1").Range("d2").Resize(.Count) = Application.Transpose(.keys)
End With
End Sub

 

[concogia]

Nhân việc nghiên cứu Method Keys mình xin bổ sung cách lấy dữ liệu duy nhất ở bài #1, 1 cách rút gọn hơn

Sub copyunique()
 Dim sArr, item 'khai bao bien can thiet
 With Sheets("sheet1")
    sArr = .Range(.[A2], .[A65000].End(xlUp)).Value 'gan vung du lieu vao mang
 End With
  With CreateObject("Scripting.Dictionary") 'tao dic
    For Each item In sArr 'duyet cac item trong sarr
        If item <> "" Then
            If Not .exists(item) Then 'xem xet coi cac item co ton tai trong dic khong                
                .Add item, ""   'add cac item do vao dic                
            End If
        End If
    Next
Sheets("sheet1").Range("d2").Resize(.Count) = Application.Transpose(.keys)
End With
End Sub

Xỉn quá, nhưng xin chúc mừng thằng em đẹp trai dân sông nước miền Tây vượt qua ngưỡng quan trọng này
Nếu xem đây là Xì-Pam xin smod cứ xóa ........vào ngày mai

 

[ndu96081631]

Nhân việc nghiên cứu Method Keys mình xin bổ sung cách lấy dữ liệu duy nhất ở bài #1, 1 cách rút gọn hơn

Sub copyunique()
 Dim sArr, item 'khai bao bien can thiet
 With Sheets("sheet1")
    sArr = .Range(.[A2], .[A65000].End(xlUp)).Value 'gan vung du lieu vao mang
 End With
  With CreateObject("Scripting.Dictionary") 'tao dic
    For Each item In sArr 'duyet cac item trong sarr
        If item <> "" Then
            If Not .exists(item) Then 'xem xet coi cac item co ton tai trong dic khong                
                .Add item, ""   'add cac item do vao dic                
            End If
        End If
    Next
Sheets("sheet1").Range("d2").Resize(.Count) = Application.Transpose(.keys)
End With
End Sub

Mọi thứ như thế là khá chuẩn rồi, chỉ xin góp ý 1 điểm nhỏ:
- Mai này nếu bạn muốn "vượt" ra khỏi phạm vi ứng dụng của Excel thì đừng xài TRANSPOSE
- Hàm TRANSPOSE tuy có cái hay là "xoay" mảng 90 độ mà không cần vòng lập nhưng lại thường bị lỗi với dữ liệu lớn
- Nếu bạn chịu khó viết thêm 1 vòng lập nữa để biến mảng 1 chiều thành 2 chiều rồi so sánh tốc độ với TRANSPOSE, bạn sẽ thấy chẳng có sự chênh lệch nào đáng kể cả
- Ngoài ra cũng có thể làm như bài 1, chỉnh kích thước của mảng kết quả thừa hơn 1 chút cũng chẳng có vấn đề gì
-----------------------
Tóm lại, điều tôi muốn nói là: KHÔNG NÊN DÙNG TRANSPOSE nói riêng và không nên dùng mọi thứ có liên quan đến WorksheetFunction nói chung

 

[nmhung49]

Mọi thứ như thế là khá chuẩn rồi, chỉ xin góp ý 1 điểm nhỏ:
- Mai này nếu bạn muốn "vượt" ra khỏi phạm vi ứng dụng của Excel thì đừng xài TRANSPOSE
- Hàm TRANSPOSE tuy có cái hay là "xoay" mảng 90 độ mà không cần vòng lập nhưng lại thường bị lỗi với dữ liệu lớn
- Nếu bạn chịu khó viết thêm 1 vòng lập nữa để biến mảng 1 chiều thành 2 chiều rồi so sánh tốc độ với TRANSPOSE, bạn sẽ thấy chẳng có sự chênh lệch nào đáng kể cả
- Ngoài ra cũng có thể làm như bài 1, chỉnh kích thước của mảng kết quả thừa hơn 1 chút cũng chẳng có vấn đề gì
-----------------------
Tóm lại, điều tôi muốn nói là: KHÔNG NÊN DÙNG TRANSPOSE nói riêng và không nên dùng mọi thứ có liên quan đến WorksheetFunction nói chung

Nhân buổi chiều cuối tuần Sếp cho nghĩ xả hơi, em làm tiếp việc nghiên cứu về Keys cho nhiều cột dữ liệu. Với không dùng Hàm Transpose mà sau em không sử dụng được Method Keys? Em vẫn thích dùng keys hơn. Mong các bạn, anh, chị chỉ giúp

Sub copyunique1()
Dim sArr, item, lCol As Long, Arr(), jRow As Long, iRow As Long
With Sheets("sheet1")
.Range("g1").CurrentRegion.Clear
For lCol = 1 To .Cells(1, 1).End(xlToRight).Column
sArr = .Range(.Cells(1, lCol), .Cells(65000, lCol).End(xlUp)).Value
    ReDim Arr(1 To UBound(sArr), 1 To 1)
    With CreateObject("Scripting.Dictionary")
        For Each item In sArr
        jRow = jRow + 1
            If item <> "" Then
                If Not .exists(item) Then
                   iRow = iRow + 1
                   .Add item, ""
                   Arr(iRow, 1) = sArr(jRow, 1)
                End If
            End If
        Next
    iRow = 0: jRow = 0
    Sheets("sheet1").Range("E1").Offset(, lCol).Resize(.Count) = Arr    
    End With
Next lCol
End With
End Sub

 

[ndu96081631]

Nhân buổi chiều cuối tuần Sếp cho nghĩ xả hơi, em làm tiếp việc nghiên cứu về Keys cho nhiều cột dữ liệu. Với không dùng Hàm Transpose mà sau em không sử dụng được Method Keys? Em vẫn thích dùng keys hơn. Mong các bạn, anh, chị chỉ giúp

Vậy bạn muốn dùng Keys như thế nào đây?
Nêu nhớ rằng Keys tương đương với mảng 1 chiều. Trong khi đó, bạn lại đang thao tác với mảng 2 chiều, vậy dùng Keys là sao mà được chứ
-------------
Nói thêm: Code của bạn biến đổi range thành Array, vì thế chẳng cần phải có dòng Option Base 1 thì mảng tạo thành cũng mặc định là Base 1 rồi

 

[nmhung49]

Vậy bạn muốn dùng Keys như thế nào đây?
Nêu nhớ rằng Keys tương đương với mảng 1 chiều. Trong khi đó, bạn lại đang thao tác với mảng 2 chiều, vậy dùng Keys là sao mà được chứ

Vậy dùng hàm Transpose thì mới dùng keys được phải không anh, ý em là như dzầy nè khì duyệt qua 1 cột thì nó sẽ add vào keys và mình lấy keys đó ra những gì add vào keys sẽ bị xóa, sau đó duyệt tiếp cột 2 lấy keys đã add đó ra cứ như thế đó mà em làm hoài không được ặc..ặc... Em có test thử đoạn code trên với dữ liều nhiều thì Transpose chậm hơn

 

[ndu96081631]

Vậy dùng hàm Transpose thì mới dùng keys được phải không anh, ý em là như dzầy nè khì duyệt qua 1 cột thì nó sẽ add vào keys và mình lấy keys đó ra những gì add vào keys sẽ bị xóa, sau đó duyệt tiếp cột 2 lấy keys đã add đó ra cứ như thế đó mà em làm hoài không được ặc..ặc... Em có test thử đoạn code trên với dữ liều nhiều thì Transpose chậm hơn

Đương nhiên nếu dùng Keys thì phải kèm TRANSPOSE rồi (để biến mảng 1 chiều thành 2 chiều)
Mặc khác, bạn muốn dùng 1 Dic cho nhiều lần cũng chẳng khó gì ---> Đừng dùng With... End With mà hãy Set Dic = CreateObject("Scripting.Dictionary") ở bên trong vòng lập đầu tiên. Tức là mỗi lần lập thì Set... và động tác Set này sẽ quét sạch mọi thứ có trong nó (keys, Items gì gì cũng bay luôn)
Hy vọng bạn hiểu!

 

[Nguyễn Duy Tuân]

Các bạn lưu ý. Hàm TRANSPOSE chỉ chạy được với mảng có số phần tử mảng tối đa là 5461, tức là MaxRows * MaxCols <= 5461 thì mảng này sẽ dùng được với hàm TRANSPOSE. Tôi cũng khuyên các bạn không nên dùng hàm TRANSPOSE của Excel, hãy tự viết hàm đảo mảng!

 

[nmhung49]

Trong quá trình tìm hiểu về Sort mảng 1 chiều trong diễn đàn em xin bổ xung đoạn code này mong anh chị trong diễn đàn góp ý, như em thấy có 1 bất lợi về dùng hàm Transpose với dữ liệu lớn phải thêm vòng lặp.

Sub SortArrayList()
With CreateObject("System.Collections.ArrayList")
    .Add "Giai"
    .Add "Phap"
    .Add "Excel"
    .Sort
Range("A1").Resize(.Count).Value = Application.Transpose(.ToArray)
End With
End Sub

Tham khảo link System.Collections

 

[ThuNghi]

Trong quá trình tìm hiểu về Sort mảng 1 chiều trong diễn đàn em xin bổ xung đoạn code này mong anh chị trong diễn đàn góp ý, như em thấy có 1 bất lợi về dùng hàm Transpose với dữ liệu lớn phải thêm vòng lặp.

Sub SortArrayList()
With CreateObject("System.Collections.ArrayList")
    .Add "Giai"
    .Add "Phap"
    .Add "Excel"
    .Sort
Range("A1").Resize(.Count).Value = Application.Transpose(.ToArray)
End With
End Sub

Tham khảo link System.Collections

Cái này chắc vận dụng để sort mảng > 1 chiều được. Mình sort trước cột cần sort, sau đó dùng dic để xác định Item và gán lại.
Nhưng sao nó chỉ sort text.

Sub SortArrayList()
Dim i&
Dim sArr, tmpArr, rArr
sArr = Array(3, 2, 2, 6, "a", 0)
ReDim rArr(1 To UBound(sArr) + 1, 1 To 1)
Dim SysCo As Object
Set SysCo = CreateObject("System.Collections.ArrayList")
For i = LBound(sArr) To UBound(sArr)
  With SysCo
    .Add CStr(sArr(i))
  End With
Next i
With SysCo
  .Sort
  tmpArr = .toarray
End With
For i = LBound(tmpArr) To UBound(tmpArr)
  rArr(i + 1, 1) = tmpArr(i)
Next i
Range("A1").Resize(i, 1).Value = rArr
Erase sArr, tmpArr, rArr
Set SysCo = Nothing
End Sub

Quên, sort theo key (cột 1) là có thể trùng nên cũng khó add Dic

 

[ndu96081631]

Trong quá trình tìm hiểu về Sort mảng 1 chiều trong diễn đàn em xin bổ xung đoạn code này mong anh chị trong diễn đàn góp ý, như em thấy có 1 bất lợi về dùng hàm Transpose với dữ liệu lớn phải thêm vòng lặp.

Sub SortArrayList()
With CreateObject("System.Collections.ArrayList")
    .Add "Giai"
    .Add "Phap"
    .Add "Excel"
    .Sort
Range("A1").Resize(.Count).Value = Application.Transpose(.ToArray)
End With
End Sub

Tham khảo link System.Collections

Làm việc với dữ liệu lớn nên "dẹp" thằng TRANSPOSE đi
Ta nên làm thế này:

Sub SortArrayList()
  Dim tmpArr, i As Long, Arr()
  With CreateObject("System.Collections.ArrayList")
    .Add "Giai"
    .Add "Phap"
    .Add "Excel"
    .Sort
    tmpArr = .ToArray
    ReDim Arr(1 To .Count, 1 To 1)
  End With
  For i = 0 To UBound(tmpArr)
    Arr(i + 1, 1) = tmpArr(i)
  Next
  Range("A1").Resize(i).Value = Arr
End Sub

Tốn thêm 1 vòng lập nữa nhưng cứ yên tâm vì tiến trình duyệt qua mảng sẽ diễn ra cực nhanh

 

[Hoàng Trọng Nghĩa]

Các bạn làm ơn kiểm tra dùm thủ tục này xem, tại sao trên file đã lưu, tôi dùng thủ tục này mà chạy code nó cứ báo False là thế nào? Mình sai gì ở thủ tục này?

Sub KiemTraFile()
    MsgBox CreateObject("Scripting.FileSystemObject").FileExists(ThisWorkbook.Path)
End Sub

 

[thanhlanh]

Các bạn làm ơn kiểm tra dùm thủ tục này xem, tại sao trên file đã lưu, tôi dùng thủ tục này mà chạy code nó cứ báo False là thế nào? Mình sai gì ở thủ tục này?

Sub KiemTraFile()
    MsgBox CreateObject("Scripting.FileSystemObject").FileExists(ThisWorkbook.Path)
End Sub

Hỏi giỡn hay hỏi thiệt vậy? (Nếu thiệt chắc do đang bị sốt)
Vậy mới True chớ nhỉ:
MsgBox CreateObject("Scripting.FileSystemObject").FileExists(ThisWorkbook.Path & "/" & ThisWorkbook.Name)

 

[dhn46]

Các bạn làm ơn kiểm tra dùm thủ tục này xem, tại sao trên file đã lưu, tôi dùng thủ tục này mà chạy code nó cứ báo False là thế nào? Mình sai gì ở thủ tục này?

Sub KiemTraFile()
    MsgBox CreateObject("Scripting.FileSystemObject").FileExists(ThisWorkbook.Path)
End Sub

Anh Nghĩa hôm nay bị chị nào "chọc léc" rùi nha, hi
Cái: ThisWorkbook.Path cho ra đường dẫn thư mục
Chắc anh đang nhắc tới cái : ThisWorkbook.FullName cho ra đường dẫn File

 

[Hoàng Trọng Nghĩa]

Hỏi giỡn hay hỏi thiệt vậy? (Nếu thiệt chắc do đang bị sốt)
Vậy mới True chớ nhỉ:
MsgBox CreateObject("Scripting.FileSystemObject").FileExists(ThisWorkbook.Path & "/" & ThisWorkbook.Name)

Anh Nghĩa hôm nay bị chị nào "chọc léc" rùi nha, hi
Cái: ThisWorkbook.Path cho ra đường dẫn thư mục
Chắc anh đang nhắc tới cái : ThisWorkbook.FullName cho ra đường dẫn File

Hahahaha, hôm qua chắc bị phân tâm việc đi Biên Hòa - Đồng Nai hay không (vì đi có 1 mình nên ngại đường xa quá, cũng may có một người tình .......... nguyện đi chung) cho nên đầu óc bị "mụ" ra!

Lẽ ra mình phải viết là:

MsgBox CreateObject("Scripting.FileSystemObject").FolderExists(ThisWorkbook.Path)

Nhưng lại viết là:

MsgBox CreateObject("Scripting.FileSystemObject").FileExists(ThisWorkbook.Path)

VIẾT SAI CẤU TRÚC CÒN LA LÀNG NỮA! ẶC ... ẶC ...

 

[ndu96081631]

Hahahaha, hôm qua chắc bị phân tâm việc đi Biên Hòa - Đồng Nai hay không (vì đi có 1 mình nên ngại đường xa quá, cũng may có một người tình .......... nguyện đi chung) cho nên đầu óc bị "mụ" ra!

Lẽ ra mình phải viết là:

MsgBox CreateObject("Scripting.FileSystemObject").FolderExists(ThisWorkbook.Path)

Nhưng lại viết là:

MsgBox CreateObject("Scripting.FileSystemObject").FileExists(ThisWorkbook.Path)

VIẾT SAI CẤU TRÚC CÒN LA LÀNG NỮA! ẶC ... ẶC ...

Như tôi đã nói hôm qua (lúc nhậu): Có code có thể kiểm tra cả Folder và File. Đó là thằng API PathFileExists

Private Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsW" (ByVal pszPath As Long) As Long

Nhìn cú pháp hàm chắc tự "phăng" được chứ

 

[Hoàng Trọng Nghĩa]

Như tôi đã nói hôm qua (lúc nhậu): Có code có thể kiểm tra cả Folder và File. Đó là thằng API PathFileExists

Private Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsW" (ByVal pszPath As Long) As Long

Nhìn cú pháp hàm chắc tự "phăng" được chứ

Hồi đó còn bàn về thằng em CreateObject("Scripting.FileSystemObject").FolderExists này ở bài này:

http://www.giaiphapexcel.com/forum/...dựa-vào-list-EXCEL-có-sẵn&p=445923#post445923

Vậy mà hôm qua "ngu" đột xuất mới ghê! Chắc lâu quá không xài nên memory bị locked rồi!

 

[Kiều Mạnh]

Trong quá trình nghiên cứu về Create Object mình thấy nó rất hay nhưng chưa hiểu hết ý nghĩa của nó. Hôm nay mình xin mở chủ đề này để tập hợp các câu lệnh về Create Object để hiểu rõ hơn về ý nghĩa của nó. Mình xin nổ phát súng đầu tiên về CreateObject("Scripting.Dictionary"). Mình thấy chức năng này rất hay trong lấy dữ liệu duy nhất. Mong các bạn, Anh Chị giúp đỡ để chủ đề sôi nổi hơn. Có gì sai xót xin các Bạn và Anh Chị bỏ qua

Sub copyunique()
Dim sArr, Arr() As String, Li As Long, item 'khai bao bien can thiet
sArr = Sheets("sheet1").Range([A2], [A65000].End(xlUp)).Value 'gan vung du lieu vao mang
ReDim Arr(1 To UBound(sArr, 1), 1 To LBound(sArr, 1)) 'thay doi kich  thuoc mang
With CreateObject("Scripting.Dictionary") 'tao dic
    For Each item In sArr 'duyet cac item trong sarr
        If Not .exists(item) Then 'xem xet coi cac item co ton tai trong dic khong
            Li = Li + 1
            .Add item, ""   'add cac item do vao dic
            Arr(Li, 1) = item   'gan item du lieu can lay vao arr
        End If
    Next
End With
Sheets("sheet1").Range("d2").Resize(UBound(Arr)) = Arr 'lay du lieu co trong arr ra
End Sub

Mình có giải thích các câu lệnh không biết có đúng không nữa giải thích đại theo mình hiểu ặc...ặc.... Vậy cho mình hỏi nếu lấy dữ liệu trùng và duy nhất thì làm sao???
Bạn tham khảo thêm về mảng tại đây http://www.giaiphapexcel.com/forum/showthread.php?46834-Các-câu-hỏi-về-mảng-trong-VBA-(Array)

cảm ơn Bạn cùng các Bạn GPE rất nhiều đã mở ra đề chủ đề này ... mình là người mới tập làm quen với VBA đã học được rất nhiều từ những điều cơ bản này ... mình đọc đang hay đến trang 3 sao lại ngưng ko hỏi và trả lời nữa vậy ... để mình có cơ hội đọc và học... mình rất mong sẽ có nhiều bài như vậy Xin cảm ơn các bạn