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

  • Thread starter Thread starter viehoai
  • Ngày gửi Ngày gửi
Liên hệ QC
viehoai

viehoai

Thành viên gắn bó
Tham gia
22/5/09
Bài viết
2,599
Được thích
2,908
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
VetMini đã viết:
Cách bạn diễn tả rất khó hiểu, rất khó viết code cho chính xác. Vì vậy nếu bạn thấy code của mình được rồi thì cứ việc xài.
Tôi chỉ nói về cái vụ "kết nối" và "dữ liệu lặp lại" cho các bạn khác để ý nếu muốn copy code về thử.
Nhấp chuột vào đây để mở rộng...
Dạ, Thật ra em nói nhiều lúc em còn không hiểu nữa á.

Mục đích của là như vầy:

1. Em có 1 list những item. Do số lượng có thể lên đến 500 items, nhưng hệ thống chỉ cho load mỗi lần khoảng 250 items thôi.
2. Nhưng em muốn cho nó load một lần, không phải thoát ra rồi load lại.

Vì vậy nên em mới cho nó ngắt ra để load.

Là như vậy anh.

Cảm ơn anh đã hỗ trợ,
 
Upvote 0
Dạ chào Anh Em,

cái này chuyển thành mãng như thế nào ạ. Xin cảm ơn,

Public Sub MU()
Dim i, j, k As Long
Dim fn As Worksheet
Set fn = Worksheets("FINAL")
k = 2
fn.Range("Q:V").ClearContents
fn.Range("Q2").Resize(, 8) = Array("ITEM", "DATE_DUE", "QTY", "D/N/H", "RUN#", "IN-CHARGE", "LINE", "DATE")
For i = 3 To fn.Range("A" & Rows.Count).End(xlUp).Row
For j = 5 To 13
If fn.Cells(i, j).Value > 0 Then
k = k + 1
fn.Cells(k, 17) = fn.Cells(i, 2) 'ITEM
fn.Cells(k, 18) = Format(fn.Cells(2, j), "mmddyyyy") & fn.Cells(i, 1) 'DATE_DUE
fn.Cells(k, 19) = fn.Cells(i, j) 'QTY
fn.Cells(k, 20) = fn.Cells(i, 14) 'DO NOT
fn.Cells(k, 21) = fn.Cells(i, 3)
fn.Cells(k, 22) = fn.Cells(i, 15)
fn.Cells(k, 23) = fn.Cells(i, 1)
fn.Cells(k, 24) = "1" & Format(fn.Cells(2, j), "YYMMDD") 'DATE
End If
Next j
Next i
MsgBox "Get data finished!!"
End Sub
 

File đính kèm

Upvote 0
phuoclocvl đã viết:
Dạ chào Anh Em,

cái này chuyển thành mãng như thế nào ạ. Xin cảm ơn,

Public Sub MU()
Dim i, j, k As Long
Dim fn As Worksheet
Set fn = Worksheets("FINAL")
k = 2
fn.Range("Q:V").ClearContents
fn.Range("Q2").Resize(, 8) = Array("ITEM", "DATE_DUE", "QTY", "D/N/H", "RUN#", "IN-CHARGE", "LINE", "DATE")
For i = 3 To fn.Range("A" & Rows.Count).End(xlUp).Row
For j = 5 To 13
If fn.Cells(i, j).Value > 0 Then
k = k + 1
fn.Cells(k, 17) = fn.Cells(i, 2) 'ITEM
fn.Cells(k, 18) = Format(fn.Cells(2, j), "mmddyyyy") & fn.Cells(i, 1) 'DATE_DUE
fn.Cells(k, 19) = fn.Cells(i, j) 'QTY
fn.Cells(k, 20) = fn.Cells(i, 14) 'DO NOT
fn.Cells(k, 21) = fn.Cells(i, 3)
fn.Cells(k, 22) = fn.Cells(i, 15)
fn.Cells(k, 23) = fn.Cells(i, 1)
fn.Cells(k, 24) = "1" & Format(fn.Cells(2, j), "YYMMDD") 'DATE
End If
Next j
Next i
MsgBox "Get data finished!!"
End Sub
Nhấp chuột vào đây để mở rộng...
Tham khảo code chuyển qua mảng:
Mã: 
Public Sub MU_Array()
Dim i As Long, j As Long, k As Long, sArr(), reArr()
With Worksheets("FINAL")
    .Range("Q:X").ClearContents
    .Range("Q2").Resize(, 8) = Array("ITEM", "DATE_DUE", "QTY", "D/N/H", "RUN#", "IN-CHARGE", "LINE", "DATE")
    sArr = .Range("A3:O" & .Range("A65535").End(xlUp).Row).Value
    ReDim reArr(1 To 9 * UBound(sArr, 1), 1 To 8)
    For i = 1 To UBound(sArr, 1)
        For j = 5 To 13
            If sArr(i, j) > 0 Then
                k = k + 1
                reArr(k, 1) = sArr(i, 2) 'ITEM
                reArr(k, 2) = Format(sArr(2, j), "mmddyyyy") & sArr(i, 1) 'DATE_DUE
                reArr(k, 3) = sArr(i, j) 'QTY
                reArr(k, 4) = sArr(i, 14) 'DO NOT
                reArr(k, 5) = sArr(i, 3)
                reArr(k, 6) = sArr(i, 15)
                reArr(k, 7) = sArr(i, 1)
                reArr(k, 8) = "1" & Format(sArr(2, j), "YYMMDD") 'DATE
            End If
        Next j
    Next i
    If k Then .Range("Q3").Resize(k, 8) = reArr
    MsgBox "Get data finished!!"
End With
End Sub
 

File đính kèm

Upvote 0
leonguyenz đã viết:
Tham khảo code chuyển qua mảng:
Mã: 
Public Sub MU_Array()
Dim i As Long, j As Long, k As Long, sArr(), reArr()
With Worksheets("FINAL")
    .Range("Q:X").ClearContents
    .Range("Q2").Resize(, 8) = Array("ITEM", "DATE_DUE", "QTY", "D/N/H", "RUN#", "IN-CHARGE", "LINE", "DATE")
    sArr = .Range("A3:O" & .Range("A65535").End(xlUp).Row).Value
    ReDim reArr(1 To 9 * UBound(sArr, 1), 1 To 8)
    For i = 1 To UBound(sArr, 1)
        For j = 5 To 13
            If sArr(i, j) > 0 Then
                k = k + 1
                reArr(k, 1) = sArr(i, 2) 'ITEM
                reArr(k, 2) = Format(sArr(2, j), "mmddyyyy") & sArr(i, 1) 'DATE_DUE
                reArr(k, 3) = sArr(i, j) 'QTY
                reArr(k, 4) = sArr(i, 14) 'DO NOT
                reArr(k, 5) = sArr(i, 3)
                reArr(k, 6) = sArr(i, 15)
                reArr(k, 7) = sArr(i, 1)
                reArr(k, 8) = "1" & Format(sArr(2, j), "YYMMDD") 'DATE
            End If
        Next j
    Next i
    If k Then .Range("Q3").Resize(k, 8) = reArr
    MsgBox "Get data finished!!"
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Dạ, cho em hỏi thêm, sao phải nhân 9 chổ này ạ
ReDim reArr(1 To 9 * UBound(sArr, 1), 1 To 8)
 
Upvote 0
phuoclocvl đã viết:
Dạ, cho em hỏi thêm, sao phải nhân 9 chổ này ạ
ReDim reArr(1 To 9 * UBound(sArr, 1), 1 To 8)
Nhấp chuột vào đây để mở rộng...
Bạn cho J chạy từ 5 đến 13, có 9 cột.
Nếu dữ liệu sArr(i,j) > 0 đều thỏa mãn thì bạn phải cần 9* Ubound(sArr,1) dòng để ghi vào mảng kết quả reArr
 
Upvote 0
Ba Tê đã viết:
Option Explicit

Public Sub sGpe()
Dim sArr(), dArr(), I As Long, N As Long, R As Long, Tmp As String
sArr = Range("A1", Range("A50000").End(xlUp)).Value 'Cot A, bat dau tu A1'
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 1)
For I = 1 To R Step 5 'Buoc nhay 5'
Tmp = ""
For N = I To I + 4
If N <= R Then Tmp = Tmp & IIf(Len(Tmp), "; ", "") & sArr(N, 1)
Next N
dArr(I, 1) = Tmp
Next I
'------------------------------ Format Cot B Kieu Text'
Range("B1").Resize(R) = dArr 'Ket Qua bat dau tu B1'
End Sub
Nhấp chuột vào đây để mở rộng...
Có ai giải thích cho em tại sao mảng dArr(R, 1) có giá trị theo chiều ngang mà gán được giá trị theo chiều dọc được ko. Em ngỡ phải dùng hàm Tranpose nữa nhỉ???
 
Upvote 0
phuoclocvl đã viết:
Theo mình biết thì (dArr(R,1)) giống như cell .
Nhấp chuột vào đây để mở rộng...
Theo toán học, toán tử "giống như" có tính truyền. Nếu A giống như B và B giống như C thì suy ra A giống như C.
Nếu bạn biết dArr(R,1) giống như cell, và từ đó bạn suy ra dArr(R,1) giống như mảng thì bắt buộc phải có một chỗ nào đó bạn "biết" là cell giống như mảng? Rất tiếc, cell không hề giống như mảng.
Kết lại, giả thuyết của bạn, dArr(R,1) là mảng đã sai từ đầu. Chưa kể đến giả thuyết "có giá trị theo chiều ngang".
 
Upvote 0
VetMini đã viết:
Theo toán học, toán tử "giống như" có tính truyền. Nếu A giống như B và B giống như C thì suy ra A giống như C.
Nếu bạn biết dArr(R,1) giống như cell, và từ đó bạn suy ra dArr(R,1) giống như mảng thì bắt buộc phải có một chỗ nào đó bạn "biết" là cell giống như mảng? Rất tiếc, cell không hề giống như mảng.
Kết lại, giả thuyết của bạn, dArr(R,1) là mảng đã sai từ đầu. Chưa kể đến giả thuyết "có giá trị theo chiều ngang".
Nhấp chuột vào đây để mở rộng...
Anh VetMini nói đúng: mảng không giống cell.
Nếu nói giống thì chỉ giống cách tra cứu dòng, cột: Range.Cells(r, c) là cách tra cứu giá trị 1 cell trong range, Arr(r, c) là tra cứu giá trị 1 phần tử của mảng
 
Upvote 0
Em mới tập tành viết code VBA và có viết thử hàm nội suy 1 chiều dùng mảng ạ nhưng mà không hiểu sao khi nội suy xong giá trị của nó tính ra lại bằng 1 hoặc bằng 0, trong khi em dùng công thức đó tính tay thử kết quả lại ra đúng với lại em xem các giá trị của biến trên cửa sổ Local thì gán đều đúng mà không hiểu sao lại lại không nội suy được mong được các anh chị trên diễn đàn giúp đỡ tìm lỗi em cảm ơn ạ.
Function noisuykz(diahinh As String, caodo As Double) As Double
Dim arr1()
arr1 = Array(3, 5, 10, 15, 20, 30, 40, 50, 60, 80, 100, 150, 200, 250, 300, 350, 400) 'cao do z
arr1(0) = 3
Dim arr2()
arr2 = Array(1, 1.07, 1.18, 1.24, 1.29, 1.37, 1.43, 1.47, 1.51, 1.57, 1.62, 1.72, 1.79, 1.84, 1.84, 1.84, 1.84) 'dia hinh A
arr2(0) = 1
Dim arr3()
arr3 = Array(0.8, 0.88, 1, 1.08, 1.13, 1.22, 1.28, 1.34, 1.38, 1.45, 1.51, 1.63, 1.71, 1.78, 1.84, 1.84, 1.84) 'dia hinh B
arr3(0) = 0.8
Dim arr4()
arr4 = Array(0.47, 0.54, 0.66, 0.74, 0.8, 0.89, 0.97, 1.03, 1.08, 1.18, 1.25, 1.4, 1.52, 1.62, 1.7, 1.78, 1.84) 'dia hinh C
arr4(0) = 0.47
Dim i As Long, x1 As Double, x3 As Double, y1 As Double, y3 As Double
For i = 0 To 16
If arr1(i) <= caodo And arr1(i + 1) >= caodo Then
Exit For
Else
End If
Next i
x1 = arr1(i)
x3 = arr1(i + 1)
If diahinh = "A" Then
y1 = arr2(i)
y3 = arr2(i + 1)
ElseIf diahinh = "B" Then
y1 = arr3(i)
y3 = arr3(i + 1)
ElseIf diahinh = "C" Then
y1 = arr4(i)
y3 = arr4(i + 1)
End If
noisuykz = (y3 * (caodo - x1) + y1 * (x3 - caodo)) \ (x3 - x1)
End Function
 
Upvote 0
Khanh199x đã viết:
Em mới tập tành viết code VBA và có viết thử hàm nội suy 1 chiều dùng mảng ạ nhưng mà không hiểu sao khi nội suy xong giá trị của nó tính ra lại bằng 1 hoặc bằng 0, trong khi em dùng công thức đó tính tay thử kết quả lại ra đúng với lại em xem các giá trị của biến trên cửa sổ Local thì gán đều đúng mà không hiểu sao lại lại không nội suy được mong được các anh chị trên diễn đàn giúp đỡ tìm lỗi em cảm ơn ạ.
Function noisuykz(diahinh As String, caodo As Double) As Double
Dim arr1()
arr1 = Array(3, 5, 10, 15, 20, 30, 40, 50, 60, 80, 100, 150, 200, 250, 300, 350, 400) 'cao do z
arr1(0) = 3
Dim arr2()
arr2 = Array(1, 1.07, 1.18, 1.24, 1.29, 1.37, 1.43, 1.47, 1.51, 1.57, 1.62, 1.72, 1.79, 1.84, 1.84, 1.84, 1.84) 'dia hinh A
arr2(0) = 1
Dim arr3()
arr3 = Array(0.8, 0.88, 1, 1.08, 1.13, 1.22, 1.28, 1.34, 1.38, 1.45, 1.51, 1.63, 1.71, 1.78, 1.84, 1.84, 1.84) 'dia hinh B
arr3(0) = 0.8
Dim arr4()
arr4 = Array(0.47, 0.54, 0.66, 0.74, 0.8, 0.89, 0.97, 1.03, 1.08, 1.18, 1.25, 1.4, 1.52, 1.62, 1.7, 1.78, 1.84) 'dia hinh C
arr4(0) = 0.47
Dim i As Long, x1 As Double, x3 As Double, y1 As Double, y3 As Double
For i = 0 To 16
If arr1(i) <= caodo And arr1(i + 1) >= caodo Then
Exit For
Else
End If
Next i
x1 = arr1(i)
x3 = arr1(i + 1)
If diahinh = "A" Then
y1 = arr2(i)
y3 = arr2(i + 1)
ElseIf diahinh = "B" Then
y1 = arr3(i)
y3 = arr3(i + 1)
ElseIf diahinh = "C" Then
y1 = arr4(i)
y3 = arr4(i + 1)
End If
noisuykz = (y3 * (caodo - x1) + y1 * (x3 - caodo)) \ (x3 - x1)
End Function
Nhấp chuột vào đây để mở rộng...
Tôi thấy cái công thức nó bị sao đó.Bạn thử cái này xem.
Mã: 
noisuykz = (y3 * (caodo - x1) + y1 * (x3 - caodo)) / (x3 - x1)
 
Upvote 0
\ là phép chia số nguyên.
Bài toán của bạn dùng tất cả đối số, thừa số là số thực. Lý do tại sao lại chia số nguyên?
 
Upvote 0
snow25 đã viết:
Tôi thấy cái công thức nó bị sao đó.Bạn thử cái này xem.
Mã: 
noisuykz = (y3 * (caodo - x1) + y1 * (x3 - caodo)) / (x3 - x1)
Nhấp chuột vào đây để mở rộng...
Em làm được rồi cảm ơn anh chỗ phép chia em bị sai
Bài đã được tự động gộp:

VetMini đã viết:
\ là phép chia số nguyên.
Bài toán của bạn dùng tất cả đối số, thừa số là số thực. Lý do tại sao lại chia số nguyên?
Nhấp chuột vào đây để mở rộng...
Dạ em đã nhận ra chỗ sai rồi cảm ơn anh đã nhắc nhở
 
Upvote 0
Xin chào mọi người
Mình có đoạn code sau hiện ko hiểu sai chỗ nào.
Objective: dời giá trí 1 cột lên t dòng.
Vd:
A1: 1
A2: 2
A3: A
A4: B

Function(A1:A4,2) <-- chọn xuất kết quả từ B1:B4
B1: A
B2: B
B3: 1
B4: 2

Cơ bản là thế. Đoạn code của mình:
Mã: 
Option Explicit
Option Base 1


Function ShiftVector(rng As Range, n As Integer) As Variant
Dim i As Integer, t As Integer
Dim A() As Variant
Dim nrow As Integer

nrow = rng.Rows.Count
n = n Mod nrow

ReDim A(nrow) As Variant

For i = 1 To nrow
    t = (i + n) Mod nrow
    If t = 0 Then t = nrow
    A(i) = rng(t)
Next i

ShiftVector = A

End Function

Vấn đề: Vd nếu function(A1:A4,2) thì cột B mình xuất ra toàn giá trị 1. Mình ko biết sai chỗ nào

Cảm ơn mọi người
 
Upvote 0
Code của bạn nó không hẳn đi sát với "objective" của bạn (hy vọng rằng khi dùng từ này, bạn hiểu rõ nó là gì)
Khi nói về cột và dòng, người ta nói về array. Hàm của bạn nó mang tên vector.
Khác với vector, mảng (array) trong VBA xác định chiều rất rõ rệt.
Nếu bạn muốn làm việc với array thì xem lại cách định chiều trong code.
 
Lần chỉnh sửa cuối:
Upvote 0
quocturtle đã viết:
Xin chào mọi người
Mình có đoạn code sau hiện ko hiểu sai chỗ nào.
Objective: dời giá trí 1 cột lên t dòng.
Vd:
A1: 1
A2: 2
A3: A
A4: B

Function(A1:A4,2) <-- chọn xuất kết quả từ B1:B4
B1: A
B2: B
B3: 1
B4: 2

Cơ bản là thế. Đoạn code của mình:
Mã: 
Option Explicit
Option Base 1


Function ShiftVector(rng As Range, n As Integer) As Variant
Dim i As Integer, t As Integer
Dim A() As Variant
Dim nrow As Integer

nrow = rng.Rows.Count
n = n Mod nrow

ReDim A(nrow) As Variant

For i = 1 To nrow
    t = (i + n) Mod nrow
    If t = 0 Then t = nrow
    A(i) = rng(t)
Next i

ShiftVector = A

End Function

Vấn đề: Vd nếu function(A1:A4,2) thì cột B mình xuất ra toàn giá trị 1. Mình ko biết sai chỗ nào

Cảm ơn mọi người
Nhấp chuột vào đây để mở rộng...
Bạn thử cái này xem có đúng không.
Mã: 
Function chuyen(ByVal mang As Range, ByVal so As Integer)
        Dim kq() As String, i As Long, arr, a As Long
        arr = mang.Value
        ReDim kq(1 To UBound(arr), 1 To 1)
        a = so Mod UBound(arr)
        For i = 1 To UBound(arr)
            a = a + 1
            If a > UBound(arr) Then a = 1
            kq(i, 1) = arr(a, 1)
       Next i
       chuyen = kq
End Function
 
Upvote 0
snow25 đã viết:
Bạn thử cái này xem có đúng không.
Mã: 
Function chuyen(ByVal mang As Range, ByVal so As Integer)
        Dim kq() As String, i As Long, arr, a As Long
        arr = mang.Value
        ReDim kq(1 To UBound(arr), 1 To 1)
        a = so Mod UBound(arr)
        For i = 1 To UBound(arr)
            a = a + 1
            If a > UBound(arr) Then a = 1
            kq(i, 1) = arr(a, 1)
       Next i
       chuyen = kq
End Function
Nhấp chuột vào đây để mở rộng...

Code hơi cẩu thả. Tiết kiệm 1 biến, để rồi tính UBound đến mấy lần?
 
Lần chỉnh sửa cuối:
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
Giao diện mới ở "chế độ tối" mờ quá
    • Thích
Trả lời
3
Đọc
51
hpkhuong
hpkhuong
J
quản lý dữ liệu theo cách quản lý bãi container
    • Thích
Trả lời
2
Đọc
7K
vunhai
V
N
  • Question Question
Cần giúp rút gọn code vba
Trả lời
1
Đọc
25
BuiQuangThuan
B
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
13 14 15
Trả lời
298
Đọc
20K
ongke0711
ongke0711
HeSanbi
  • Đã giải quyết
ExplorerXL - Quản lý thư mục với Excel: tìm, đổi tên, sao chép, di chuyển và xóa
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
78
Đọc
16K
HeSanbi
HeSanbi
B
Xin hàm đếm số lượng khách hàng theo 1 điều kiện và bỏ dữ liệu trùng.
Trả lời
8
Đọc
270
Phan Thế Hiệp
Phan Thế Hiệp
M
Sắp xếp dữ liệu: Lọc tên theo ABC (alphabet) có lỗi tên Đam đứng trước Diệp
Trả lời
13
Đọc
5K
maidinhdung5
maidinhdung5
S
Tính trung bình của tháng đầu tiên.
Trả lời
1
Đọc
111
Phan Thế Hiệp
Phan Thế Hiệp
Nguyễn Duy Tuân
Hàm BS_FORMATTEXT Tạo công thức định dạng văn bản trong Excel với Add-in A-Tools v10
Trả lời
0
Đọc
26
Nguyễn Duy Tuân
Nguyễn Duy Tuân
Nguyễn Duy Tuân
Hàm BS_TEXT trộn văn bản trong Excel với Add-in A-Tools v10
Trả lời
0
Đọc
25
Nguyễn Duy Tuân
Nguyễn Duy Tuân
aduc
Nhật ký thi công bằng excel
    • Thích
2
Trả lời
36
Đọc
53K
PhanTuHuong
PhanTuHuong
T
  • Question Question
Xin code VBA trả về tên tài khoản theo điều kiện
    • Chấp nhận
Trả lời
8
Đọc
142
ptm0412
ptm0412
likosin
xin cách lọc này với ạ.
Trả lời
4
Đọc
124
ptm0412
ptm0412
OverAC
[Thông báo] Diễn đàn tạm ngừng hoạt động để bảo trì từ 21g thứ Sáu ngày 20/12
    • Thích
    • Cảm ơn
Trả lời
1
Đọc
929
OverAC
OverAC
A
Nhờ xử lý tính toán Số nằm trong chuỗi kí tự
2
Trả lời
20
Đọc
548
SteveNguyen1991
S
V
  • Question Question
FILE EXCEL LOI : WE FOUND A PROBLEM ... RECOVER
Trả lời
0
Đọc
67
vuasutu08
V
D
  • Question Question
Gửi Email chào giá hàng loạt cho đối tác có nhúng 1 bảng báo giá vào mail
Trả lời
3
Đọc
184
BuiQuangThuan
B
likosin
Nhờ các bác hướng dẫn ạ.
Trả lời
1
Đọc
80
yaaasoo01
Y
C
Lỗi hàm days360
Trả lời
9
Đọc
185
HieuCD
H
HeSanbi
  • Đã giải quyết
HÀM FITROW - Co giãn dòng tự động tối ưu nhất cho Excel v2.43 (*14/10/2024)
    • Thích
    • Yêu thích
2 3
Trả lời
50
Đọc
22K
HeSanbi
HeSanbi
Xem thêm…

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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới
Back
Top Bottom