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

[viehoai]

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ị

 

[doveandrose]

yêu cầu ở file nén của bạn là gì vậy? copy các file ở folder 1-->n về file tổng hợp

dạ yêu cầu trong file nén đây ạ , anh giúp em với

 

[Let'GâuGâu]

dạ yêu cầu trong file nén đây ạ , anh giúp em với

dạ, em định dzọc bằng ADO
vba không còn hứng nữa.......nhưng có được hay không còn hên xui......mà chắc xui nhiều hơn quá.......hihihihi

 

[Let'GâuGâu]

Topic này như bị đóng băng hay sao mà ko có ai hỏi nữa nhỉ? ^^
Nay mình có 2 vấn đề khó lại phiền các cao thủ xuất sơn trợ giúp
Vấn đề 1. Mình nên yêu cầu trong file
Vấn đề 2: Mình cũng nêu trong file
Cả 2 vấn đề chắc cũng tốn không ít thời gian của các bác, mình xin cảm ơn nhiều.

yêu cầu 2, coppy về file tổng hợp
làm thử coppy file folder 1
nếu đúng thì sẻ làm tiếp (thử thêm một vòng lặp), không đúng thì chạy luộn.....hihiih........đi ngủ đây........đến giờ lên giường rồi

Option Explicit
Dim SourceFile As String
Public Sub GetLastedUpDateFile()
    Dim fso, oFolder, oSubfolder, oFile, queue As Collection
Dim LastedDate As Date
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set queue = New Collection
    queue.Add fso.GetFolder("C:\Users\Dell optiplex 380\Desktop\test\Folder 1") 'doi lai thu muc

    Do While queue.Count > 0
        Set oFolder = queue(1)
        queue.Remove 1
        For Each oSubfolder In oFolder.SubFolders
            queue.Add oSubfolder
        Next oSubfolder
        For Each oFile In oFolder.Files
            If oFile.DateLastModified > LastedDate Then LastedDate = oFile.DateLastModified: SourceFile = oFile
        Next oFile
    Loop
    Copy_Range (SourceFile)
End Sub
Sub Copy_Range(SourceFile)
    Dim rsCon As Object
    Dim rsData As Object
    Dim szConnect, SourceSheet, SourceRange As String
    Dim szSQL As String
    Dim lCount As Long
 
  SourceSheet = "Sheet1"
  SourceRange = "A3:B60000"
    
    szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=No"";"
    szSQL = "SELECT * FROM [" & SourceSheet & "$" & SourceRange$ & "]"
    
    Set rsCon = CreateObject("ADODB.Connection")
    Set rsData = CreateObject("ADODB.Recordset")

    rsCon.Open szConnect
    rsData.Open szSQL, rsCon, 0, 1, 1
    
    If Not rsData.EOF Then
        [a1].End(4).Offset(1).CopyFromRecordset rsData
    Else
        MsgBox "No records returned from : " & SourceFile, vbCritical
    End If

    rsData.Close
    Set rsData = Nothing
    rsCon.Close
    Set rsCon = Nothing


End Sub

============
đợi bạn test lâu quá, chỉnh lại code luôn nè

Option Explicit
Dim SourceFile As String
Public Sub GetLastedUpDateFile()
    Dim fso, oFolder, oSubfolder, oFile, FolderList As Collection
Dim LastedDate As Date
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set FolderList = New Collection
    FolderList.Add fso.GetFolder("D:\NAM\test") 'doi lai thu muc

    Do While FolderList.Count > 0
        Set oFolder = FolderList(1)
        FolderList.Remove 1
        For Each oSubfolder In oFolder.SubFolders
            For Each oFile In oSubfolder.Files
                If oFile.DateLastModified > LastedDate Then LastedDate = oFile.DateLastModified: SourceFile = oFile
            Next oFile
            Copy_Range (SourceFile)
        Next oSubfolder
    Loop
   
End Sub
Sub Copy_Range(SourceFile)
    Dim rsCon As Object
    Dim rsData As Object
    Dim szConnect, SourceSheet, SourceRange As String
    Dim szSQL As String
    Dim lCount As Long
 
  SourceSheet = "Sheet1"
  SourceRange = "A3:B60000"
    
    szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=No"";"
    szSQL = "SELECT * FROM [" & SourceSheet & "$" & SourceRange$ & "]"
    
    Set rsCon = CreateObject("ADODB.Connection")
    Set rsData = CreateObject("ADODB.Recordset")

    rsCon.Open szConnect
    rsData.Open szSQL, rsCon, 0, 1, 1
    
    If Not rsData.EOF Then
        [a6000].End(3).Offset(1).CopyFromRecordset rsData
    Else
        MsgBox "No records returned from : " & SourceFile, vbCritical
    End If

    rsData.Close
    Set rsData = Nothing
    rsCon.Close
    Set rsCon = Nothing


End Sub

 

[pjsoga]

Thanks bác nhiều! Nhưng vấn đề 1 em còn điều kiện VietNam không thấy bác nêu
Vấn đề 2 chạy cho Folder 1 nhưng chạy lặp lại 3 lần?

 

[Let'GâuGâu]

Vấn đề 2 chạy cho Folder 1 nhưng chạy lặp lại 3 lần?

bạn lấy đoạn code nào chạy vậy?
nhớ khai báo lại đường dẫn nha

 

[huyendhxd]

Chào các bác!!!
Em mới tập làm VBA, em đang viết hàm nội suy cho một bảng như hình

Va duoi day la code em moi viet
Public Function Noisuy(x As Double, y As Double) As Double
Dim Dulieu(7, 7) As Double, chieu1(7, 1) As Double, chieu2(1, 7) As Double
Dim x1 As Double, x2 As Double
Dim i As Integer, j As Integer
Dim dl As Range, c1 As Range, c2 As Range
Set dl = Range("B2:H8").Value2
Set c1 = Range("A2:A8").Value2
Set c2 = Range("B1:H1").Value2
Dulieu = Range("B2:H8")
chieu1 = Range("A2:A8")
chieu2 = Range("B1:H1")
For i = 1 To 7
For j = 1 To 7
Dulieu(i, j) = dl.Cells(i, j).Value
chieu1(i, 1) = c1.Cells(i, 1).Value
chieu2(1, j) = c2.Cells(1, j).Value
Next
Next
For i = 1 To UBound(chieu1, 1) - 1 Step 1
For j = 1 To UBound(chieu2, 2) - 1 Step 1
If x >= chieu1(i, 1) And x <= chieu1(i + 1, 1) And y >= chieu2(1, j) And y <= chieu2(1, j + 1) Then
x1 = Dulieu(i, j) + (Dulieu(i + 1, j) - Dulieu(i, j)) / (chieu1(i + 1, 1) - chieu1(i, 1)) * (x - chieu1(i, 1))
x2 = Dulieu(i, j + 1) + (Dulieu(i + 1, j + 1) - Dulieu(i, j + 1)) / (chieu1(i + 1, 1) - chieu1(i, 1)) * (x - chieu1(i, 1))
Noisuy = x1 + (x2 - x1) / (chieu2(1, j + 1) - chieu2(1, j)) * (y - chieu2(1, j))
Else: MsgBox "Chon lai gia tri"
Next
Next
End Function

Vấn đề là sau khi viết xong thì không dùng được

Bác nào vui lòng chỉ giáo cho em với ạ.

Em xin cảm ơn nhiều ạ.

 

[huyendhxd]

Xin gửi các bác cái hình có bảng. Em quên mất

 

[langtuchungtinh360]

Hỏi về khai báo mảng lồng

mọi người cho em hỏi vấn đề thế này
ví dụ như ta khai báo
Arr(2) => Arr(0), Arr(1), Arr(2)
rồi Arr(0) = range("A1:A3")
rồi Arr(1) = range("B1:B3")
rồi Arr(2) = range("C1:C3")
thì ta được 1 mảng lồng ghép với nhau
là Arr(0)(1,1)
Arr(0)(2,1)
Arr(0)(3,1)
......< chỗ này không biết đúng ko nữa>
vậy cho em hỏi
ta có thể khai báo kích thước của Arr(0) lại Arr(0) (0 to 10)
cái chỗ màu đỏ đó có được không, và khai báo lại thế nào vậy ạ

 

[VetMini]

ta có thể khai báo kích thước của Arr(0) lại Arr(0) (0 to 10)
cái chỗ màu đỏ đó có được không, và khai báo lại thế nào vậy ạ

Lý do tại sao muốn làm thế?

 

[langtuchungtinh360]

Lý do tại sao muốn làm thế?

học hỏi thêm thôi mà bác. với có việc cần dùng đến nó nên hỏi vậy mà.

 

[VetMini]

học hỏi thêm thôi mà bác. với có việc cần dùng đến nó nên hỏi vậy mà.

Có đến vài cách thực hiện. Tôi hỏi lý do là để dùng cách đúng nhất. Trả lời khơi khơi thế lấy gì mà mò.
Thôi nhường người khác vậy.

 

[langtuchungtinh360]

Có đến vài cách thực hiện. Tôi hỏi lý do là để dùng cách đúng nhất. Trả lời khơi khơi thế lấy gì mà mò.
Thôi nhường người khác vậy.

học hỏi thêm thì không chỉ được sao bác @@
tại có vấn đề thế này

ví dụ em muốn chèn giá trị của mảng vào A110
khai báo C1: Arr(3) thì được 4 giá trị tương đương 4 cột (ở đây do số cột không cố định nên không thể khai báo nhiều mảng được nên em nghĩ cách dùng mảng thế này thì số cột thay đổi linh động hơn.) tương đương 1 Arr(x) là 1 mảng (rõ hơn xin đọc tiếp)
---------------------------------------------------------------------------------------------------------------
rồi lý do tại sao lại làm như thế mà không dùng C2: Arr(1 to x, 1 to y) - y cột x dòng (đơn giản)
là do em chỉ muốn điền kết quả theo cột chứ không điền nguyên mảng xuống cells
---------------------------------------------------------------------------------------------------------------
vì sao lại muốn như thế ? => ví dụ như em muốn điền xuống A110
và ở cột C1:C10 lại có công thức
nếu như dùng C2 thì cột C sẽ mất đi công thức nên em muốn dùng theo C1 là điền từng mảng xuống cho cột A, B, D, vì vậy công thức tại cột C sẽ không mất
em có nghĩ ra 1 cách là khai báo 1 mảng ArrTam(1000) hoăc Arr(1 to 1000, 1 to 1) rồi gán nó vô mảng Arr là Arr(0) = ArrTam, Arr(1) = ArrTam.....
theo cách này thì cũng đúng ý nhưng lại tống tài nguyên cho mảng ArrTam -> ảnh hưởng đến chạy code
vấn đề là thế. mong được sự giúp đỡ từ bác và mọi người

 

[VetMini]

em có nghĩ ra 1 cách là khai báo 1 mảng ArrTam(1000) hoăc Arr(1 to 1000, 1 to 1) rồi gán nó vô mảng Arr là Arr(0) = ArrTam, Arr(1) = ArrTam.....
theo cách này thì cũng đúng ý nhưng lại tống tài nguyên cho mảng ArrTam -> ảnh hưởng đến chạy code
vấn đề là thế. mong được sự giúp đỡ từ bác và mọi người

Trình độ về tài nguyên của tôi chỉ biết đến việc dùng mảng tĩnh (fixed size & predeclared type) sẽ được một vùng nhớ liên tục và do đó hiệu quả hơn mảng động.
Còn việc tốn tài nguyên cho mảng tạm có ảnh hưởng đến chạy code hay không thì quá mức hiểu biết của tôi.

Ngoài ra, theo trường phái học của tôi thì việc tốn bộ nhớ chỉ quan trọng khi người ta viết hàm gọi nhau liên tục, và nhất là hàm đệ quy, vì bộ nhớ ngăn xếp có giới hạn. Chứ code chạy chỉ một hàm duy nhất thì vài cái mảng hàng chục triệu bytes chả có nghĩa lý gì cả.

 

[VetMini]

học hỏi thêm thì không chỉ được sao bác @@...

Tôi đã quen với cái tật hỏi úp úp mở mở của quý vị.
Ở trên tôi nói rõ "có vài cách làm". Nếu tôi không hỏi ngược lại thì làm sao quý vị tiết lộ ra là mình đã biết 1 cách, nhưng còn chê nó dở.

 

[ndu96081631]

nếu như dùng C2 thì cột C sẽ mất đi công thức

Nếu bạn dung thuộc tính Formula thì sẽ không mất công thức (arr = Range(...).Formula)

------------------------------------

nên em muốn dùng theo C1 là điền từng mảng xuống cho cột A, B, D, vì vậy công thức tại cột C sẽ không mất
em có nghĩ ra 1 cách là khai báo 1 mảng ArrTam(1000) hoăc Arr(1 to 1000, 1 to 1) rồi gán nó vô mảng Arr là Arr(0) = ArrTam, Arr(1) = ArrTam.....
theo cách này thì cũng đúng ý nhưng lại tống tài nguyên cho mảng ArrTam -> ảnh hưởng đến chạy code
vấn đề là thế. mong được sự giúp đỡ từ bác và mọi người

Tôi cũng thường dùng cách 1, vèo cái là xong chứ có gì đâu mà tốn tài nguyên

 

[tueyennhi]

Em có code sau:

If Arr(J, 7) = "" And Arr(J, 8) = "" And Arr(J, 9) = "" Then

Code này có thể viết thành dạng Resize được không ạ? Em viết như này thì báo lỗi:

If Arr(J, 7).Resize(Rws, 3) then

 

[Gió Đông]

Em có code sau:

If Arr(J, 7) = "" And Arr(J, 8) = "" And Arr(J, 9) = "" Then

Code này có thể viết thành dạng Resize được không ạ? Em viết như này thì báo lỗi:

If Arr(J, 7).Resize(Rws, 3) then

Không, tại sao thì bạn tự suy nghĩ xem cho hiểu sâu và đúng hơn vì tôi không biết Arr thuộc loại biến gì(?)

 

[tueyennhi]

Arr là mảng winvista
Rws = Range("C65536").End(xlUp).Row

Arr() = [E9].Resize(Rws, 9).Value
ReDim dArr(1 To Rws, 1 To 2)
For J = 1 To UBound(Arr())

 

[befaint]

@tueyennhi,

Nếu Dim Arr() As Variant
thì có thể viết:
if Arr(J, 7) + Arr(J, 8) + Arr(J, 9) = empty then

Resize là thuộc tính của range.
range.resize()

 

[tueyennhi]

Vậy thì chắc không có cách viết nào khác mà xử lý dữ liệu nhanh hơn cách viết này mọi người nhỉ:

 If Arr(J, 7) = "" And Arr(J, 8) = "" And Arr(J, 9) = "" Then
        dArr(J, 2) = ""
 ElseIf Arr(J, 7) <> "" And Arr(J, 8) <> "" And Arr(J, 9) <> "" Then
        dArr(J, 2) = ""
 Else
        dArr(J, 2) = 1
 End If

Code trên để check sự tồn tại dữ liệu ở 3 ô. Nếu tất cả đều có dữ liệu hoặc không có dữ liệu thì ra giá trị ""
Còn lại là giá trị 1