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ị

Ba Tê · 11/6/19

Minh Tùng đã viết:
Tại vì em viết để dể hình dung đó anh
Bình thường nếu 1 vùng thì em sẽ viết là:

With Sheet1.Range("B2:B" & LastRow)
Code trong đây....
End With

Nhưng em chọn nhiều vùng không liên tục kèm theo biến LastRow thì em chưa làm được ạ.
Anh giúp em thêm được không?

Xem thử Sub này coi nó hoạt động được không nhé.

PHP:

Public Sub Gpe()
Dim LastRws As Long
LastRws = 10
Range("A1:A" & LastRws & ",C1:C" & LastRws & ",E1:E" & LastRws) = "GPE"
End Sub

befaint · 11/6/19

Minh Tùng đã viết:
chọn nhiều vùng không liên tục kèm theo biến LastRow

PHP:

Sub vidu()
    Const last_Row As Long = 9
    array_range = Array("B2:C" & last_Row, "E2:E" & last_Row, "G2:G" & last_Row, "I2:K" & last_Row)
    string_range = Join(array_range, ",")
    Sheet1.Range(string_range).Select
End Sub

snow25 · 11/6/19

Minh Tùng đã viết:
Tại vì em viết để dể hình dung đó anh
Bình thường nếu 1 vùng thì em sẽ viết là:

With Sheet1.Range("B2:B" & LastRow)
Code trong đây....
End With

Nhưng em chọn nhiều vùng không liên tục kèm theo biến LastRow thì em chưa làm được ạ.
Anh giúp em thêm được không?

Vậy bạn viết như thế này.
With Sheet1.Range("B2:B" & LastRow & ",D2

" & lastrow)
Code trong đây....
End With

Minh Tùng · 11/6/19

Ba Tê đã viết:
Xem thử Sub này coi nó hoạt động được không nhé.

PHP:

Public Sub Gpe() Dim LastRws As Long LastRws = 10 Range("A1:A" & LastRws & ",C1:C" & LastRws & ",E1:E" & LastRws) = "GPE" End Sub

snow25 đã viết:
Vậy bạn viết như thế này.
With Sheet1.Range("B2:B" & LastRow & ",D2" & lastrow)
Code trong đây....
End With

befaint đã viết:

PHP:

Sub vidu()
    Const last_Row As Long = 9
    array_range = Array("B2:C" & last_Row, "E2:E" & last_Row, "G2:G" & last_Row, "I2:K" & last_Row)
    string_range = Join(array_range, ",")
    Sheet1.Range(string_range).Select
End Sub

Em cám ơn anh @Ba Tê , anh @snow25 , anh @befaint
3 cách của 3 anh đều sử dụng được hết ạ.

Ngô Vương Thông · 12/6/19

Anh chị cho em hỏi , e muốn đưa Worksheets("PHMail").Range("A1:A12") vào 1 mảng
sau đó sẽ cho mỗi dòng tương ứng trong mảng() =.... [VD: mảng() = UniConvert(" Yeeu caafu hoox trowj : ", "Telex") & arr(i, 12) ]
=> Cuối cùng e gán mảng() lên Listview
Note : ở userform e có để một textbox stt => khi nhập stt vào sẽ nhảy đúng nội dung theo dòng của mảng()
Hiện tại khi e thay đổi STT thì nội dung vẫn sẽ được thay đổi nhưng tốc độ rất chậm, quay khoảng 3s mới có kết quả
Mong các anh chị chỉ giáo tối ưu giúp em

Dim arr(), i As Long
If Worksheets("Record_Ticket").Range("A2000").End(xlUp).Row < 2 Then Exit Sub
arr = Worksheets("Record_Ticket").Range("A2", Worksheets("Record_Ticket").Range("A2000").End(xlUp)).Resize(, 27).Value
'Worksheets("PHMail").Range("A1,A3,A4,A5,A6,A9").ClearContents
i = Worksheets("PHMail").Range("C2").Value
If i <> Empty Then
If i <= UBound(arr) Then
If arr(i, 20) = "" Then
Worksheets("PHMail").Range("A1") = ConvertToUnSign("Tiep Nhan" & "-" & arr(i, 7) & "-")
Worksheets("PHMail").Range("A3") = UniConvert(" Yeeu caafu hoox trowj : ", "Telex") & arr(i, 12)
Worksheets("PHMail").Range("A4") = UniConvert(" Thowfi gian nhaajn yeeu caafu hoox trowj : " & arr(i, 3) & " - " & arr(i, 4), "Telex")
Worksheets("PHMail").Range("A5") = UniConvert(" Thowfi gian tieesn hafnh hoox trowj : " & arr(i, 3) & " - " & arr(i, 19), "Telex")
Worksheets("PHMail").Range("A6") = UniConvert(" Thowfi gian xuwr lys hoafn taast : " & arr(i, 22) & " - " & arr(i, 20), "Telex")
Worksheets("PHMail").Range("A9") = "-" & arr(i, 15)
Else
Worksheets("PHMail").Range("A1") = ConvertToUnSign("Hoan tat" & "-" & arr(i, 7) & "-" & arr(i, 8) & "-" & arr(i, 12))
Worksheets("PHMail").Range("A3") = UniConvert(" Yeeu caafu hoox trowj : ", "Telex") & arr(i, 12)
Worksheets("PHMail").Range("A4") = UniConvert(" Thowfi gian nhaajn yeeu caafu hoox trowj : " & arr(i, 3) & " - " & arr(i, 4), "Telex")
Worksheets("PHMail").Range("A5") = UniConvert(" Thowfi gian tieesn hafnh hoox trowj : " & arr(i, 3) & " - " & arr(i, 19), "Telex")
Worksheets("PHMail").Range("A6") = UniConvert(" Thowfi gian xuwr lys hoafn taast : " & arr(i, 22) & " - " & arr(i, 20), "Telex")
Worksheets("PHMail").Range("A9") = "-" & arr(i, 15)
End If
End If
End If

phuoclocvl · 11/7/19

Các Anh cho em hỏi.
Thí dụ trong 1 cột em muốn nối các cell lại với nhau, nhưng không phải nối lại hết mà nối 5 cell chẳn hạn, rồi thực thi những tác vụ khác, rồi nối tiếp từ cell 6 tới cell 10 và tiếp tục thực thi tiếp cho đến khi hết dữ liệu. Em chỉ biết nối hết 1 lần à. Ko biết tách ra.
Code em nè
Sub Test()
Dim eR As Long
Dim i As Long
Dim temp As String
With Sheet1
eR = .Range("A10000").End(xlUp).Row
For i = 2 To eR
If .Cells(i, 1) <> "" Then
temp = temp & .Cells(i, 1) & "','"
End If
Next i
.Range("B1") = "('" & Left(temp, Len(temp) - 2) & ")"
End With
End Sub

SA_DQ · 12/7/19

phuoclocvl đã viết:
Các Anh cho em hỏi. . . . .

PHP:

Sub gpeNoi5()
With Sheet1
    eR = [A65500].End(xlUp).Row
    For I = 2 To eR Step 5
        If .Cells(I, 1) <> "" Then
            For W = 0 To 4
                Temp = Temp & .Cells(I + W, 1) & "','"
            Next W
            .Cells(I, 2).Value = Temp:                  Temp = ""
        End If
        GPELamGiTiepThiLam
    Next I
End With
End Sub

? Chưa chắc đã đúng ý của bạn.

phuoclocvl · 12/7/19

SA_DQ đã viết:

PHP:

Sub gpeNoi5()
With Sheet1
    eR = [A65500].End(xlUp).Row
    For I = 2 To eR Step 5
        If .Cells(I, 1) <> "" Then
            For W = 0 To 4
                Temp = Temp & .Cells(I + W, 1) & "','"
            Next W
            .Cells(I, 2).Value = Temp:                  Temp = ""
        End If
        GPELamGiTiepThiLam
    Next I
End With
End Sub

? Chưa chắc đã đúng ý của bạn.

Dạ chào Anh,
kết quả có vẻ ngon rồi đấy, nhưng sao bỏ được mấy cái nối trống phía sau anh. dòng 16 á có nhiều cái dưa quá à

A
1	1','2','3','4','5','
2
3
4
5
6	6','7','8','9','10','
7
8
9
10
11	11','12','13','14','15','
12
13
14
15
16	16','','','','','

Ba Tê · 12/7/19

phuoclocvl đã viết:
...................
kết quả có vẻ ngon rồi đấy, nhưng sao bỏ được mấy cái nối trống phía sau anh. dòng 16 á có nhiều cái dưa quá à

Bạn thử với cái này xem sao:

PHP:

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

SA_DQ · 12/7/19

Câu lệnh
Temp = Temp & .Cells(I + W, 1) & "','"
biến hóa từ nguồn của bạn mà: temp = temp & .Cells(i, 1) & "','"
Mình nghỉ bạn sẽ phải tự xử lý chuyện này & mình tin chắc là được

(Gợi ý: Ra điều kiện trước khi nối chuỗi; Đó là cách tuy dài dòng trong câu lệnh nhưng thông dụng & dễ xử!)

phuoclocvl · 12/7/19

SA_DQ đã viết:
Câu lệnh
Temp = Temp & .Cells(I + W, 1) & "','"
biến hóa từ nguồn của bạn mà: temp = temp & .Cells(i, 1) & "','"
Mình nghỉ bạn sẽ phải tự xử lý chuyện này & mình tin chắc là được

(Gợi ý: Ra điều kiện trước khi nối chuỗi; Đó là cách tuy dài dòng trong câu lệnh nhưng thông dụng & dễ xử!)

Dạ,

Đã xử xong rồi hì . cảm ơn các anh nhiều nhiều nha

Sub gpeNoi5()
With Sheet1
eR = [A65500].End(xlUp).Row
For I = 2 To eR Step 5
If .Cells(I, 1) <> "" Then
For W = 0 To 4
If .Cells(I + W, 1) <> "" Then
Temp = Temp & .Cells(I + W, 1) & "','"
End if
Next W
.Cells(I, 2).Value = Temp: Temp = ""
End If
GPELamGiTiepThiLam
Next I
End With
End Sub

phuoclocvl · 12/7/19

SA_DQ đã viết:
Câu lệnh
Temp = Temp & .Cells(I + W, 1) & "','"
biến hóa từ nguồn của bạn mà: temp = temp & .Cells(i, 1) & "','"
Mình nghỉ bạn sẽ phải tự xử lý chuyện này & mình tin chắc là được

(Gợi ý: Ra điều kiện trước khi nối chuỗi; Đó là cách tuy dài dòng trong câu lệnh nhưng thông dụng & dễ xử!)

Mục đích em là vầy nè các anh, em đã chạy OK rồi. xin đa tạ ạ

Dim Temp As String, iLock As String, eDr As Integer
Dim sD As Worksheet, rD As Worksheet
Dim adors As New Recordset
Set sD = Worksheets("Final")
Set rD = Worksheets("BOM_MAT")
rD.Range("A3:K").End(xlUp).ClearContents
rD.Range("A2").Resize(, 11) = Array("IT_FG", "SUB_IT", "BOM_REQ", "IT_CLASS", "BOM_DESC", "IT_TYPE", "SUB_TYPE", "UNIT", "SITE", "TYPE_R", "SECTION")
eR = sD.Range("A100000").End(xlUp).Row
For I = 2 To eR Step 250
If sD.Cells(I, 1) <> "" Then
For W = 0 To 249
If sD.Cells(I + W, 1) <> "" Then
Temp = Temp & sD.Cells(I + W, 1) & "','"
End If
Next W
iLock = "('" & Left(Temp, Len(Temp) - 2) & ")": Temp = ""
End If
'--- Bat dau load du lieu he thong -----
Set Db = New Connection
Db.CursorLocation = adUseClient

If Db.State = 1 Then Db.Close
Db.Open "PROVIDER=MSDASQL;DRIVER={Client Access ODBC Driver (32-bit)}" & _
";SYSTEM=10.9.3.106;DBQ=QGPL " & _
"AMFLIBW;DFTPKGLIB=QGPL;XLATEDLL=;" & _
"LANGUAGEID=ENU;SORTTABLE=;PKG=QGPL/DEFAULT(IBM),2,0,1,0,512;QAQQINILIB=;" & _
"DESC=;XDYNAMIC=0;TRANSLATE=1;" & _
";UID=WANEKPIC" & _
";PWD=WANEKPIC"

Set adors = New Recordset
If adors.State = 1 Then adors.Close

cmdtxt = "SELECT DISTINCT TRIM(PSTBOMD.BOMPIT),TRIM(PSTBOMD.BOMCIT),PSTBOMD.BOMGQT,TRIM(PSTBOMD.BOMCCL),PSTBOMD.BOMCDS,PSTBOMD.PITTYP,PSTBOMD.ITTYP,PSTBOMD.UNMSR,RTGOPR.STID " & _
"FROM RGNFILW.PSTBOMD PSTBOMD, AMFLIBW.RTGOPR RTGOPR " & _
"WHERE RTGOPR.RTID=PSTBOMD.BXDCOMPONENTITEMNUMBER AND PSTBOMD.BOMPIT in " & iLock & " AND BOMPIT NOT LIKE '%TEMP%' " & _
"AND BOMPCL IN ('UESW','WPLS','ZDYB','PLST','HDBD','WVCS','FPUW','UESC','UEPM','WNPU','WNPS','WNCS','RLRK','WNPU','UEUS','WNAD','ZSOA','TA') AND BOMGQT>0 AND BOMCIT NOT LIKE '%MOD%' AND BOMPIT NOT LIKE '%FNSH%'"
Debug.Print cmdtxt
adors.Open cmdtxt, Db, 3, 3
eDr = rD.Range("A100000").End(xlUp).Row + 1
For I1 = 0 To adors.Fields.Count - 1
rD.Cells(eDr, I1 + 1) = adors.Fields(I1).Name
Next I1
rD.Range("A" & eDr).CopyFromRecordset adors
adors.Close
Set adors = Nothing
Next I
' Chep cong thuc
eDr = rD.Range("A100000").End(xlUp).Row
rD.Range("J1:K1").Copy
rD.Range("J3:K" & dc).PasteSpecial xlPasteFormulas
Application.Calculation = xlAutomatic
rD.Range("J3:K" & dc).Copy
rD.Range("J3:K" & dc).PasteSpecial xlPasteValues
Application.Calculation = xlManual
Call get_bomrq

ThangCuAnh · 12/7/19

Good, tự mày mò, tự làm được thì rất tốt. Không ai có thể làm giúp bạn 100% cả.

VetMini · 12/7/19

Một vấn đề hỏi 2 ngày, úp úp mở mở 2 nơi. Rốt cuộc chỉ là 1 vấn đề cần nối chuỗi làm reference cho câu lệnh SQL.

(*) làm việc với database thì kết nối 1 lần, truy vấn nhiều lần chứ đâu lại mỗi lần truy vấn lại một lần kết nối.

phuoclocvl · 12/7/19

VetMini đã viết:
Một vấn đề hỏi 2 ngày, úp úp mở mở 2 nơi. Rốt cuộc chỉ là 1 vấn đề cần nối chuỗi làm reference cho câu lệnh SQL.

(*) làm việc với database thì kết nối 1 lần, truy vấn nhiều lần chứ đâu lại mỗi lần truy vấn lại một lần kết nối.

Dạ là, do em có nhiều item lắm , mà mỗi lần load dữ liệu nó chỉ cho chạy 250 items thôi anh. Nên phải ngắt ra ạ

VetMini · 12/7/19

phuoclocvl đã viết:
Dạ là, do em có nhiều item lắm , mà mỗi lần load dữ liệu nó chỉ cho chạy 250 items thôi anh. Nên phải ngắt ra ạ

Có lẽ bạn không hiểu tôi nói gì về "kết nối"

Vả lại, làm kiểu "ngắt ra" như thế này nguy hiểm bỏ xừ. Nó không bảo đảm được khi dữ liệu bị lặp lại.

phuoclocvl · 12/7/19

VetMini đã viết:
Có lẽ bạn không hiểu tôi nói gì về "kết nối"

Vả lại, làm kiểu "ngắt ra" như thế này nguy hiểm bỏ xừ. Nó không bảo đảm được khi dữ liệu bị lặp lại.

anh có cách nào hay giúp em với, em chỉ nghĩ được vậy thôi à, do em cũng không rành vụ này

VetMini · 12/7/19

phuoclocvl đã viết:
anh có cách nào hay giúp em với, em chỉ nghĩ được vậy thôi à, do em cũng không rành vụ này

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ử.

phuoclocvl · 12/7/19

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ử.

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

phuoclocvl · 16/7/19

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

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

Thành viên gắn bó

Cạo Rồi Khỏi Gội

|||||||||||||

Thành viên gạo cội

Thành viên hoạt động

Thành viên mới

Thành viên thường trực

/(hông là gì!

Thành viên thường trực

Cạo Rồi Khỏi Gội

/(hông là gì!

Thành viên thường trực

Thành viên thường trực

Mới rờ Ét xeo

Ăn cùng góc phố

Thành viên thường trực

Ăn cùng góc phố

Thành viên thường trực

Ăn cùng góc phố

Thành viên thường trực

Thành viên thường trực

File đính kèm

Facebook

Group