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ị

pjsoga · 15/8/16

Chờ đợi 2 ngày mà không có cao thủ nào bớt chút thời gian giúp em ah? **~**

HieuCD · 15/8/16

pjsoga đã viết:
Chờ đợi 2 ngày mà không có cao thủ nào bớt chút thời gian giúp em ah?

bạn giải thích kết quả cột code ở bảng bên phải nhất là của thằng a

kegiaumat · 16/8/16

Em có một bảng dữ liệu gồm 3 cột A B C chứa các mã vận đơn. Mỗi cột chứa rất nhiều khoảng 2k mã. E muốn kiểm tra các mã có trong cột A ko có trong cột B và C; có trong cột B ko có trong cột A và C; có trong cột C mà ko có trong cột A và B sau đó ghi ra cột D E F. Em đã sử dụng vòng lặp while do để so sánh từng giá trị trong cột B với C và từng giá trị trong B với A và C ; Từng giá trị trong C với A và B ( tại e ko biết cách loại bỏ đối tượng khi đã trùng với đối tượng trước ra khỏi mảng). Làm như vậy máy chạy rất đơ. Nếu ít dữ liệu thì ko sao. Dữ liệu lên lớn lớn tý là treo máy ngay. Các bác cho e lời khuyên với.
Ps: em mới viết đến đoạn lấy A so với B C thì máy đã đơ rùi

HieuCD · 16/8/16

kegiaumat đã viết:
Em có một bảng dữ liệu gồm 3 cột A B C chứa các mã vận đơn. Mỗi cột chứa rất nhiều khoảng 2k mã. E muốn kiểm tra các mã có trong cột A ko có trong cột B và C; có trong cột B ko có trong cột A và C; có trong cột C mà ko có trong cột A và B sau đó ghi ra cột D E F. Em đã sử dụng vòng lặp while do để so sánh từng giá trị trong cột B với C và từng giá trị trong B với A và C ; Từng giá trị trong C với A và B ( tại e ko biết cách loại bỏ đối tượng khi đã trùng với đối tượng trước ra khỏi mảng). Làm như vậy máy chạy rất đơ. Nếu ít dữ liệu thì ko sao. Dữ liệu lên lớn lớn tý là treo máy ngay. Các bác cho e lời khuyên với.
Ps: em mới viết đến đoạn lấy A so với B C thì máy đã đơ rùi

bạn cho file ví dụ và đưa code lên, mọi người sẽ góp ý

pjsoga · 16/8/16

Lấy giá trị của Value tăng thêm 1, tăng thêm 1 lượng bằng cột add.
VD:
Code Value Add
b___ 2 ___3
=> b(2+1), b(2+2), b(2+3)

pjsoga · 16/8/16

Lấy giá trị của Value tăng thêm 1, tăng thêm 1 lượng bằng cột add.
VD:
Code Value Add
b___ 2 ___3
=> b(2+1), b(2+2), b(2+3

HieuCD · 16/8/16

pjsoga đã viết:
Lấy giá trị của Value tăng thêm 1, tăng thêm 1 lượng bằng cột add.
VD:
Code Value Add
b___ 2 ___3
=> b(2+1), b(2+2), b(2+3

bạn giải thích rỏ về a qua tất cả các bảng, nó không cùng qui luật với b và c

pjsoga · 17/8/16

Hi, sorry bạn. Mình diễn giải nhầm mất 1 chút của a lần 2. Mình chỉnh sửa lại rồi nhé.
Giá trị xuất lần 1 giữ nguyên, lần 2 thêm vào ô bên dưới cuối cùng của lần 1, lần n thêm vào ô bên dưới của ô n-1. ( Cọt I)
Rất cảm ơn bạn đã quan tâm!

HieuCD · 18/8/16

pjsoga đã viết:
Hi, sorry bạn. Mình diễn giải nhầm mất 1 chút của a lần 2. Mình chỉnh sửa lại rồi nhé.
Giá trị xuất lần 1 giữ nguyên, lần 2 thêm vào ô bên dưới cuối cùng của lần 1, lần n thêm vào ô bên dưới của ô n-1. ( Cọt I)
Rất cảm ơn bạn đã quan tâm!

bạn xem file đúng ý chưa

SA_DQ · 18/8/16

Em có một bảng dữ liệu gồm 3 cột A B C chứa các mã vận đơn. Mỗi cột chứa rất nhiều khoảng 2k mã.
E muốn kiểm tra các mã có trong cột A ko có trong cột B và C;
có trong cột B ko có trong cột A và C;
có trong cột C mà ko có trong cột A và B
sau đó ghi ra cột D E F.

Ps: em mới viết đến đoạn lấy A so với B C thì máy đã đơ rùi

Mình fải mất hơn 2H để giả lập file cho bạn; Thế mới biết chưa ai trả lời cho bạn trước mình!

& với chương trình này, máy mình chạy dưới 9 gy.

quanluu · 18/8/16

kegiaumat đã viết:
Em có một bảng dữ liệu gồm 3 cột A B C chứa các mã vận đơn. Mỗi cột chứa rất nhiều khoảng 2k mã. E muốn kiểm tra các mã có trong cột A ko có trong cột B và C; có trong cột B ko có trong cột A và C; có trong cột C mà ko có trong cột A và B sau đó ghi ra cột D E F. Em đã sử dụng vòng lặp while do để so sánh từng giá trị trong cột B với C và từng giá trị trong B với A và C ; Từng giá trị trong C với A và B ( tại e ko biết cách loại bỏ đối tượng khi đã trùng với đối tượng trước ra khỏi mảng). Làm như vậy máy chạy rất đơ. Nếu ít dữ liệu thì ko sao. Dữ liệu lên lớn lớn tý là treo máy ngay. Các bác cho e lời khuyên với.
Ps: em mới viết đến đoạn lấy A so với B C thì máy đã đơ rùi

bạn cho hỏi, nếu cột A có nhiều mã trùng nhau mà không có trong cột B, C thì để nguyên hay chỉ lấy 1? nếu lấy duy nhất thì bạn hoàn toàn có thể làm thủ công nhé.

pjsoga · 18/8/16

Chuẩn luôn. Cám ơn bạn rất nhiều. Nhưng nhìn đoạn mã hoa cả mắt, chắc châm cứu ốm xác mới hiểu đc phần nào. ^^

pjsoga · 13/10/16

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.

Let'GâuGâu · 13/10/16

pjsoga đã viết:
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 yêu cầu file "Array"

Mã:

Option Explicit

Sub test()
Dim sRange As Range
Dim rArr(1 To 6000, 1 To 4) As Variant

Dim i, j, k As Long
Set sRange = Range("A2:H7")
rArr(1, 1) = "Date": rArr(1, 2) = "Cells": rArr(1, 3) = "Tittle": rArr(1, 4) = "Font"
k = 1
For i = 3 To sRange.Rows.Count
    For j = 3 To sRange.Columns.Count
    With sRange
        If .Cells(i, j) Like "*.XX" Then
            k = k + 1
            rArr(k, 1) = .Cells(i, 1): rArr(k, 2) = .Cells(i, j)
            rArr(k, 3) = .Cells(1, j)
            If .Cells(i, j).Font.ColorIndex = 3 Then rArr(k, 4) = "Do" Else rArr(k, 4) = "Den"
        End If
    End With
    Next
Next
If k Then
    [a15:d1000].Clear
    [a15].Resize(k, 4) = rArr
End If
End Sub

====
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

doveandrose · 13/10/16

Let'GâuGâu đã viết:
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 · 13/10/16

doveandrose đã viết:
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 · 13/10/16

pjsoga đã viết:
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

Mã:

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è

Mã:

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 · 16/10/16

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 · 16/10/16

pjsoga đã viết:
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 · 16/11/16

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 --=0

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

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

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

Thành viên gắn bó

Thành viên chính thức

Chuyên gia GPE

Thành viên mới

Chuyên gia GPE

Thành viên chính thức

Thành viên chính thức

Chuyên gia GPE

Thành viên chính thức

File đính kèm

Chuyên gia GPE

File đính kèm

/(hông là gì!

File đính kèm

Thành viên gắn bó

Thành viên chính thức

Thành viên chính thức

File đính kèm

Thành viên mới

hello

Thành viên mới

Thành viên mới

Thành viên chính thức

Thành viên mới

File đính kèm

Thành viên mới

Facebook

Group