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,600
Được thích
2,907
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
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
Xin chào mọi người, mình đang có chút thắc mắc về cách select để xuất dữ liệu bằng VBA
Cái này chắc ko mới nhưng mình ko biết key word phải kiếm thế nào nên bạn nào rành giúp mình với

Ví dụ hàm mình tùy thuộc vào dữ liệu đầu vào, đầu ra là một ma trận n x 1. Thì khi mình muốn xuất dữ liệu đầu ra thì trick là:
Range("A1:A"&n)

Còn ví dụ như nếu đầu ra của mình là ma trận (n x m) Để làm tương tự như trên thì mình viết thế nào cho đúng.
Cách giải quyết của mình hơi bị dài, cụ thể là
1. Viết một function phụ alphabettonumber trong đó quy định A = 1, B = 2, ...
2. Tính toán nội suy ra giá trị x. Ví dụ như m = 3 thì x = C
3. Range("A1:" & x & n)
Làm theo hướng của mình thì rắc rối quá, mình nghĩ trong VBA sẽ có build in function / trick giúp chuyện này dễ hơn

Mong mọi người giúp
Cảm ơn
 
Upvote 0
quocturtle đã viết:
Xin chào mọi người, mình đang có chút thắc mắc về cách select để xuất dữ liệu bằng VBA
Cái này chắc ko mới nhưng mình ko biết key word phải kiếm thế nào nên bạn nào rành giúp mình với

Ví dụ hàm mình tùy thuộc vào dữ liệu đầu vào, đầu ra là một ma trận n x 1. Thì khi mình muốn xuất dữ liệu đầu ra thì trick là:
Range("A1:A"&n)

Còn ví dụ như nếu đầu ra của mình là ma trận (n x m) Để làm tương tự như trên thì mình viết thế nào cho đúng.
Cách giải quyết của mình hơi bị dài, cụ thể là
1. Viết một function phụ alphabettonumber trong đó quy định A = 1, B = 2, ...
2. Tính toán nội suy ra giá trị x. Ví dụ như m = 3 thì x = C
3. Range("A1:" & x & n)
Làm theo hướng của mình thì rắc rối quá, mình nghĩ trong VBA sẽ có build in function / trick giúp chuyện này dễ hơn

Mong mọi người giúp
Cảm ơn
Nhấp chuột vào đây để mở rộng...
Bạn thử cái này. Range("A1").resize(n,x).value=mảng đó kiểu như vậy.
 
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

phanmoi688
[Xin nhờ giúp đỡ] Cách đối chiếu dữ liệu giữa hai biểu
    • Thích
Trả lời
17
Đọc
212
HUONGHCKT
H
LuuAnh980
Cập nhật hợp đồng của mã vật tư theo ngày.
Trả lời
6
Đọc
39
LuuAnh980
LuuAnh980
C
  • Question
Tổng hợp và nhóm nhân viên
    • Thích
Trả lời
11
Đọc
355
cubinv
C
T
Cần giúp sao chép C1 từ B1
Trả lời
1
Đọc
35
vu_tuan_manh_linh
vu_tuan_manh_linh
V
  • Question
Tìm kiếm và copy giá trị từ bảng đến bảng khác
Trả lời
7
Đọc
144
SA_DQ
SA_DQ
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

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