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

  • HELP.xlsm
    44.4 KB · Đọc: 5
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

  • HELP.xlsm
    45.6 KB · Đọc: 14
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

dung09031989
Xin giúp công thức tô màu các ô phía sau khi kế hoạch đặt hàng thiếu so với tồn kho.?
Trả lời
3
Đọc
110
hoangtuaotrang_hp_vn
H
kimtanmap
  • Question
Nhờ viết code VBA Macro lập lại.
Trả lời
6
Đọc
184
kimtanmap
kimtanmap
P
Nhờ giúp đỡ hàm lọc dữ liệu theo tỉnh
Trả lời
8
Đọc
92
Hoàng Tuấn 868
H
PhanTuHuong
Bàn về môn thể thao bóng bàn nào!
    • Thích
    • Yêu thích
    • Cười
2
Trả lời
34
Đọc
2K
PhanTuHuong
PhanTuHuong
C
Chia sẻ: Kết quả xổ số Keno
    • Cười
    • Thích
Trả lời
11
Đọc
301
SA_DQ
SA_DQ
20050911
File Excel lỗi ''The file could not be accessed. Try one of the following:.."
Trả lời
4
Đọc
154
VetMini
V
ongke0711
  • Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711)
    • Thích
    • Yêu thích
    • Cảm ơn
11 12 13
Trả lời
257
Đọc
25K
Pham Ha 233
Pham Ha 233
C
Công thức tự nhập liệu số lượng nhập khi bị âm
Trả lời
2
Đọc
116
cherry0187
C
N
Vẽ biểu đồ kết hợp nhiều yếu tố trong excel
Trả lời
4
Đọc
123
Ny Ny 2024
N
P
Tổng hợp dữ liệu từ các sheet theo chọn lọc
Trả lời
17
Đọc
323
phutdm
P
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
11 12 13
Trả lời
251
Đọc
13K
ongke0711
ongke0711
N
Định mức nguyên vật liệu
Trả lời
1
Đọc
162
yeudoi
yeudoi
GPE-Trợ Lý
KHÓA HỌC BỨT PHÁ KỸ NĂNG EXCEL
    • Thích
Trả lời
1
Đọc
306
PhanTuHuong
PhanTuHuong
B
Định dạng condition formatting, đếm hỗn hợp dữ liệu merge và không merge
Trả lời
17
Đọc
202
batista911
B
Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
2
Trả lời
30
Đọc
714
huuthang_bd
huuthang_bd
H
Tính và sắp xếp theo thư tự tăng dần có điều kiệu (có dữ liệu trùng nhau)
Trả lời
1
Đọc
39
bebo021999
B
V
  • Question
Lấy dữ liệu lãi suất từ website Sbv.gov.vn bằng Power Query
Trả lời
1
Đọc
522
Minhhanhsgu
M
Nguyễn Duy Tuân
  • Question
Chia sẻ ControlForOffice - Bộ công cụ điều khiển Office/Excel
    • Thích
6 7 8
Trả lời
149
Đọc
95K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
B
Lọc dữ liệu trùng, đếm số lần, tự tô màu theo điều kiện.
Trả lời
5
Đọc
152
batista911
B
T
Tối ưu hóa hàm lấy dữ liệu từ bảng Tổng sang bảng chi tiết
Trả lời
7
Đọc
247
Hoàng Tuấn 868
H
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

Back
Top Bottom