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

Liên hệ QC

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ị
 
Vấn đề của em khá nhỏ nên em không lập topic mới ạ (nếu em đăng sai, nhờ BQT nhắc nhở để em đăng bài mới)

Em có biến LastRow để xác định dòng cuối
Em cần chọn nhiều vùng không liền nhau kết hợp LastRow để xác định dữ liệu mảng động để format trước khi thêm dữ liệu vào sheetform nhưng em chưa viết được code (như hình em cần chọn ô bắt đầu là B2:C & LastRow, E2 & LastRow, G2 & LastRow, I2:K & LastRow,....)

Mong anh/chị GPE giúp em ạ.
Em cám ơn nhiều!
Bạn viết vậy là bị lỗi.Bạn nên tách cái nào là biến cái nào là ký tự ra chứ.Bạn viết thế kia nó không hiểu cái Lastrow là gì cả.
 
Upvote 0
Bạn viết vậy là bị lỗi.Bạn nên tách cái nào là biến cái nào là ký tự ra chứ.Bạn viết thế kia nó không hiểu cái Lastrow là gì cả.

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?
 
Upvote 0
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
 
Upvote 0
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:D" & lastrow)
Code trong đây....
End With
 
Upvote 0
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
Vậy bạn viết như thế này.
With Sheet1.Range("B2:B" & LastRow & ",D2:D" & lastrow)
Code trong đây....
End With

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 ạ.
 
Upvote 0
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

219062
 
Lần chỉnh sửa cuối:
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
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
11','2','3','4','5','
2
3
4
5
66','7','8','9','10','
7
8
9
10
1111','12','13','14','15','
12
13
14
15
1616','','','','','
 
Upvote 0
...................
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
 
Upvote 0
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ử!)
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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ả.
 
Upvote 0
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.
 
Upvote 0
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 ạ
 
Upvote 0
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.
 
Upvote 0
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.
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
 
Upvote 0
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ử.
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom