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ị

doveandrose · 1/11/15

hong loi đã viết:
Em cám ơn Thầy đã giúp, Em test rồi tốc độ vẫn đảm bảo. Em cũng test code 2, nếu chỉ xóa 1 tên tốc độ vẫn tương đương với code của Thầy.

code 2

Mã:

Private Sub Worksheet_Change(ByVal Target As Range) Dim x As Range, rngFind As Range, rng As Range If Not Intersect(Range("B2:B10000"), Target) Is Nothing Then Set rng = Intersect(Range("B2:B10000"), Target) For Each x In rng If Len(x.Value) Then If Left(x.Value, 1) = Space(1) Then x.Interior.ColorIndex = 15 Else Set rngFind = Range("O2:O10000").Find(x.Value, , xlValues, xlWhole) If rngFind Is Nothing Then x.Interior.ColorIndex = 34 Else x.Interior.ColorIndex = xlNone End If End If End If Next [COLOR=#ff8c00]On Error Resume Next If Target = "" Then Target.Offset(, -1).ClearContents Target.Offset(, 1).Resize(, 5).ClearContents Target.Offset(, -1).Resize(, 7).Interior.ColorIndex = xlNone End If[/COLOR] End If End Sub

Nhưng nếu quét khối xóa một lược nhiều tên (khoảng 3 tên trở lên) --> code 2 nhanh hơn, em đoán nguyên nhân do phần code màu cam không nằm trong vòng lặp, có phải vậy không Thầy ?

nhanh hơn là đúng rồi vì code 2 tào lao quá mà
Nếu bạn không hiểu bản chất thì nên làm theo code anh NDU viết sẵn , đừng chế lung tung
Tôi nói thí dụ đơn giản dòng này là trật lất

Mã:

[COLOR=#FF8C00][I]If Target = "" Then[/I][/COLOR]

vì Target đâu có chắc nó là 1 ô đơn đâu mà được xét như thế

doveandrose · 1/11/15

hong loi đã viết:
Cám ơn anh Let'GâuGâu giúp em, anh xem code anh viết hình như còn thiếu cái gì đó, chạy code báo lổi này.
View attachment 149769

bạn ấy có chút nhầm lẫn ấy mà . Nhưng nói chung thì không nên sử dụng cách giải ấy . Vì address String nhét vô .Range(address)
nó chỉ nhận có vài trăm kí tự , address String mà dài hơn nữa là nó tự cắt cho cụt luôn nên sẽ báo lỗi

hong loi · 1/11/15

doveandrose đã viết:
nhanh hơn là đúng rồi vì code 2 tào lao quá mà
Nếu bạn không hiểu bản chất thì nên làm theo code anh NDU viết sẵn , đừng chế lung tung
Tôi nói thí dụ đơn giản dòng này là trật lất

Mã:

[COLOR=#FF8C00][I]If Target = "" Then[/I][/COLOR]

vì Target đâu có chắc nó là 1 ô đơn đâu mà được xét như thế

Em cám ơn Thầy (Cô) doveandrose chỉ dạy, nhưng xin Thầy doveandrose chỉ dạy nhẹ tay thôi vì em còn rất " nai tơ " với VBA lắm. Để chạy được 1 lệnh VBA mà em mong muốn, em phải lùng sụt khắp Google xem cái nào na ná giống cái em cần là em lắp vô, may mắn code chạy được đúng ý là vui mừng không kể siết, cho nên không thể tránh khỏi tào lao, lung tung, trật lất....,mặc dù em biết viết

Mã:

[COLOR=#FF8C00][I]If Target = "" Then[/I][/COLOR]

là quá chung chung không phù hợp với code của Thầy NDU, nhưng em đâu biết phải làm thế nào mới đúng, em chỉ biết lắp vào như thế nó chạy nhanh hơn và em muốn nhờ các Thầy, các thành viên trong ngôi nhà GPE giúp đỡ để code chạy đúng và nhanh hơn.

Nếu em có lời nào không phải xin các Thầy cùng các bạn hiểu cho nỗi khổ của em , cảm thông cho em , từ từ chỉ dạy em nhé. Em xin cảm ơn tất cả mọi người.

hong loi · 4/11/15

ndu96081631 đã viết:

Có thể là vầy chăng

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim x As Range, rngFind As Range, rng As Range
  If Not Intersect(Range("B2:B10000"), Target) Is Nothing Then
    Set rng = Intersect(Range("B2:B10000"), Target)
    For Each x In rng
      If Len(x.Value) Then
        If Left(x.Value, 1) = Space(1) Then
          x.Interior.ColorIndex = 15
        Else
          Set rngFind = Range("O2:O10000").Find(x.Value, , xlValues, xlWhole)
          If rngFind Is Nothing Then
            x.Interior.ColorIndex = 34
          Else
            x.Interior.ColorIndex = xlNone
          End If
        End If
      [COLOR=#ff0000]Else
        x.Offset(, -1).ClearContents
        x.Offset(, 1).Resize(, 5).ClearContents
        x.Offset(, -1).Resize(, 7).Interior.ColorIndex = xlNone
      End If[/COLOR]
    Next
  End If
End Sub

Em xin chào các Thầy! Sau nhiều lần thử tới thử lui em phát hiện nguyên nhân code chạy chậm là do file excel của em có quá nhiều công thức vlookup, ngoài sheet DANH SACH file còn có 20 sheet TRUC DEM, mổi sheet TRUC DEM có cấu trúc giống nhau 55 dòng tên chứa Vlookup ở cột C,D,H và I .Chính khối Vlookup khổng lồ này làm chậm tốc độ, bằng chứng là em copy / past value cho tất cã 20 sheet TRUC DEM lập tức code của Thầy NDU chạy nhanh vù vù luôn.

Để tống khứ đống Vlookup đó đi em viết code này

Mã:

Sub ThayTheVlookup()
    Dim DuLieuTam
    Dim LastRow As Long, DongCuoiB As Long, DongCuoiG As Long, i As Integer
    Const SoDongCuoi = 50
For i = 1 To 2 'file thuc tê' có den 20 sheet
    With Sheets(i)
        DongCuoiB = Cells(SoDongCuoi, 2).End(xlUp).Row
        DongCuoiG = Cells(SoDongCuoi, 7).End(xlUp).Row
                If DongCuoiB > DongCuoiG Then
                    LastRow = DongCuoiB
                    Else: LastRow = DongCuoiG
                End If
        If LastRow < 3 Then Exit Sub
        Dim VungKetQua As Range
        Set VungKetQua = .Range("A3:I" & LastRow)
        DuLieuTam = VungKetQua
    End With
    With DanhSach
        LastRow = .Range("B" & Rows.Count).End(xlUp).Row
        If LastRow < 2 Then Exit Sub
        Dim x As Long, y As Long
        Dim rngData As Range, rngFind As Range
        Set rngData = .Range("A1:D" & LastRow)
    End With
    For x = 1 To UBound(DuLieuTam)
        Set rngFind = rngData.Find(What:=DuLieuTam(x, 2), LookIn:=xlFormulas, LookAt:=xlWhole)
        DuLieuTam(x, 1) = x
        DuLieuTam(x, 3) = rngFind.Offset(, 1)
        DuLieuTam(x, 4) = rngFind.Offset(, 2)
    Next x
    For y = 1 To UBound(DuLieuTam)
        Set rngFind = rngData.Find(What:=DuLieuTam(y, 7), LookIn:=xlFormulas, LookAt:=xlWhole)
        DuLieuTam(y, 6) = y
        DuLieuTam(y, 8) = rngFind.Offset(, 1)
        DuLieuTam(y, 9) = rngFind.Offset(, 2)
    Next y
    VungKetQua = DuLieuTam
Next i
End Sub

Nhưng nó không chạy được. Em gửi kèm file chỉ chừa lại 2 sheet TRUC DEM , sheet DANH SACH và bớt số dòng để tiện gửi file.
Kính mong các Thầy xem và sữa chửa giúp em nhé, nhân đây cho em nói lời xin lổi với Thầy NDU: " Thầy NDU ơi cho em xin lổi, Thầy đừng buồn đừng giận em nhé ".

hong loi · 4/11/15

Em cám ơn Thầy hpkhuong nhé, Thầy đoán đúng code trên là code chắp ghép chế lại ạ, Vlookup hay vlookup do em gỏ vội chỉ muốn nói đến hàm VLOOKUP.

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim fRng As Range, Clls As Range, Ds As Worksheet
Set Ds = Sheets("DANH SACH")
If Target.Row > 2 And (Target.Column = 2 Or Target.Column = 7) Then
    For Each Clls In Target
        If Clls.Value = Empty Then Clls.Offset(, 1).Resize(, 2) = Empty
    Set fRng = Ds.Range(Ds.[B2], Ds.[B10000].End(3)).Find(Clls.Value, , xlValues, xlWhole)
        If Not fRng Is Nothing Then Clls.Offset(, 1).Resize(, 2) = fRng.Offset(, 1).Resize(, 2).Value
    Next Clls
End If
End Sub

Code này chạy tốt lắm ạ.
Nếu ta chỉnh sửa dử liệu ở cột C,D của Sheets("DANH SACH") muốn các sheet TRUC DEM tự động cập nhật theo thì phải làm thế nào ạ ?

hong loi · 4/11/15

Sub ThayTheVlookup() em viết dùng đến Mảng Array (biến là DuLieuTam) với 4 mong muốn:

1. Loại bỏ hàm VLOOKUP cho nhẹ file.
2. Sau khi chỉnh sửa dử liệu cột C,D (TLƯƠNG,HỆ SỐ)ở sheet DANH SACH xong --> click nút --> tự động cập nhật vào các sheet TRUC DEM
3. Khi chỉnh sửa bớt thêm tên ở cột B,G của các sheet TRUC DEM ( thêm tên: có nghĩa là gõ tên từng ô hoặc copy một lược nhiều tên ở sheet DANH SACH past vào) xong --> cột TLƯƠNG,HỆ SỐ tự động cập nhật từ sheet DANH SACH (giống y như hàm VLOOKUP tự cập nhật vậy).
4.Tốc độ xử lí dử liệu nhanh.

Nhưng nay các mong muốn trên đành hỏi lại ở chủ đề khác để không phạm qui, em cám ơn Thầy hpkhuong nhắc nhở.

hong loi · 5/11/15

hpkhuong đã viết:
Bạn phải kéo sheet Danh Mục của bạn ra đằng trước 2 sheet TRUCDIEM thì mới chạy code đúng được.

Chú ý chỗ màu đỏ tôi tô bên dưới:
Các sheet cần update tự động thì phải để sau cùng. Vì mục đích ta duyệt qua 'Sheet.Count (bắt đầu từ sheet thứ 2, vì sheet thứ 1 là DanhSach rồi.) Nếu có nhiều sheet khác ngoài danh sách thì bạn cứ Move tới phía trước, các sheet TrucDiem cần chạy code. Sau đó xác định Sheet cần chạy code đầu tiên nằm ở số thứ tự bao 'nhiêu thì thay đổi số 2 trên vòng lặp thành số thứ tự đó....Hiểu chứ...

Mã:

For i = [COLOR=#ff0000][B]2 To Sheets.Count 'chú ý chỗ này.[/B][/COLOR]

Em đã làm theo nhưng sao click nút nó vẫn đơ ra, code chỉ chạy trong cửa sổ Microsoft Visual Basic và với điều kiện Activesheet phải là các sheet TRUC DEM, em không rỏ nguyên nhân.

hong loi · 5/11/15

hpkhuong đã viết:
Bạn kèm file lên đây, sao không chạy cơ chứ....

Dạ em gửi file anh xem giúp nhé, em dùng Excel 2003 có liên quang đến việc chạy code không anh ?

Em xin bổ xung : nếu cái nút gán ở sheet TRUC DEM code lại chạy được sao vậy ta ?

hong loi · 6/11/15

hpkhuong đã viết:
Gì vậy đồng chí. Code vậy thì bạn đứng tại bất cứ sheet nào chạy cũng có tác dụng hết.
Bạn thử xóa dữ liệu đi, đứng ở bất kỳ sheet nào chạy code nó cũng có tác dụng cả...

Các anh đã test rồi vẫn chạy bình thường à ? thế thì em chết mất, từ lúc dùng Excel đến nay em chỉ gặp code chạy báo lỗi chạy không đúng yêu cầu chứ chưa từng gặp trường hợp này bao giờ.

Let'GâuGâu · 6/11/15

hong loi đã viết:
Các anh đã test rồi vẫn chạy bình thường à ? thế thì em chết mất, từ lúc dùng Excel đến nay em chỉ gặp code chạy báo lỗi chạy không đúng yêu cầu chứ chưa từng gặp trường hợp này bao giờ.

A host application may disable or enable macros. This error has the following causes and solutions:

You opened the document with Macros Disabled. Close the document, and then reopen it with Enable Macros.

For additional information, select the item in question and press F1 (in Windows) or HELP (on the Macintosh).
ofm
=========
tôi cũng bị lổi, hãy thử với phần help

doatmenhhon · 6/11/15

Let'GâuGâu đã viết:
A host application may disable or enable macros. This error has the following causes and solutions:

You opened the document with Macros Disabled. Close the document, and then reopen it with Enable Macros.

For additional information, select the item in question and press F1 (in Windows) or HELP (on the Macintosh).
ofm
=========
tôi cũng bị lổi, hãy thử với phần help

Cái này có nghĩa là gì hở bác ^^

Let'GâuGâu · 6/11/15

doatmenhhon đã viết:
Cái này có nghĩa là gì hở bác ^^

ai biết đâu nè, nhấn cái nút, nó báo lổi, vào module cho chạy trực tiếp nó cũng báo lổi......thấy có cái nút "heo" nhấp vô thấy nó ra đám đó.......chép lên....hihihihi

giangleloi · 6/11/15

hpkhuong đã viết:
Gì kỳ vầy trời. Tôi dùng Office 2016 chạy phà phà như xe đang đổ dốc cầu sài gòn í, thế các bạn dùng 2k mấy??? Let'GâuGâu nữa ah???

Tôi chạy E2007 cũng bình thường. Không báo lỗi gì cả, kết quả đúng hay không thì hông có biết. @$@!^%

Let'GâuGâu · 6/11/15

hpkhuong đã viết:
Gì kỳ vầy trời. Tôi dùng Office 2016 chạy phà phà như xe đang đổ dốc cầu sài gòn í, thế các bạn dùng 2k mấy??? Let'GâuGâu nữa ah???

2010,
mà có gì khó đâu, save as nó lại rồi mở ra là chạy ào ào thôi mà

hong loi · 6/11/15

Buồn quá! em mài mò quay màn hình lại tình huống không chạy cho các anh xem, do file lớn quá em gửi ở đây http://www.mediafire.com/watch/2913alt82sw1u02/video_khong_chay_code.flv

khuongvietphong · 18/11/15

Em đang đọc về mảng qua Topic này. Em có đoạn CODE sau để đánh số thứ tự từ 1 đến 100 :

PHP:

Option Explicit
Sub STT2()
Dim i As Long, Arr(1 To 100) As Double 
For i = 1 To 100    
   Arr(i) = i  
Next i  
Range("A1:A100").Value = Arr() 
End Sub

Tuy nhiên nó lại toàn ra số 1. Nhờ mọi người kiểm tra giúp em sao lại bị như vậy.

doveandrose · 18/11/15

khuongvietphong đã viết:
Em đang đọc về mảng qua Topic này. Em có đoạn CODE sau để đánh số thứ tự từ 1 đến 100 :

PHP:

Option Explicit Sub STT2() Dim i As Long, Arr(1 To 100) As Double For i = 1 To 100 Arr(i) = i Next i Range("A1:A100").Value = Arr() End Sub

Tuy nhiên nó lại toàn ra số 1. Nhờ mọi người kiểm tra giúp em sao lại bị như vậy.

ủa Option Explicit là gì vẩy bạn ? có tác dụng gì ta ?
mình vớ được cái này ở đâu đó
Range("A1:A100").Value = WorksheetFunction.Transpose(Arr)

doatmenhhon · 18/11/15

khuongvietphong đã viết:
Em đang đọc về mảng qua Topic này. Em có đoạn CODE sau để đánh số thứ tự từ 1 đến 100 :

PHP:

Option Explicit Sub STT2() Dim i As Long, Arr(1 To 100) As Double For i = 1 To 100 Arr(i) = i Next i Range("A1:A100").Value = Arr() End Sub

Tuy nhiên nó lại toàn ra số 1. Nhờ mọi người kiểm tra giúp em sao lại bị như vậy.

Sửa thế này thì ok

Mã:

Sub tong()
Dim i As Long, Arr(1 To 100, 1 To 1) As Double
For i = 1 To 100
      Arr(i, 1) = i
Next i
Range("A1:A100").Value = Arr()
End Sub

khuongvietphong · 18/11/15

Cảm ơn anh DoveandRose và bạn doatmenhhon nhiều. Tức là khi gán từ mảng xuống Range thì bắt buộc mảng phải là mảng 2 chiều có đúng không ạ.

doveandrose đã viết:
ủa Option Explicit là gì vẩy bạn ? có tác dụng gì ta ?

Cái này có thật là anh hổng bít không hay lại tính chọt em đây ??

hpkhuong đã viết:
Cái bạn sửa với cái của Phong nó khác hoàn toàn nhé. 1 Cái là mảng 1 chiều, cái 2 chiều...
Ku Phong đang làm theo 1 chiều, thì Transpose mới là giái pháp đúng...

Nhờ các anh làm rõ thêm tại sao của em lại toàn ra số 1 vậy

doatmenhhon · 18/11/15

Bạn thử đổi thành Range("A1:Z1").Value = Arr() sẽ thấy rõ. Arr(i) là mảng theo hàng là mảng ngang . Mảng (“A1:A100”) là mảng theo cột là mảng dọc nên gán (“A1:A100”) = Arr thì chỉ nhận được đúng kết quả Arr(1)=1

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

Thành viên gắn bó

hello

hello

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

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

File đính kèm

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

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

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

File đính kèm

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

File đính kèm

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

Thành viên mới

Thành viên tiêu biểu

Thành viên mới

Thành viên gắn bó

Thành viên mới

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

Be all you can be !

hello

Thành viên tiêu biểu

Be all you can be !

Thành viên tiêu biểu