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

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ị

befaint · 18/10/17

chitbk đã viết:
cần làm trên chạy code tren VBA

Thử đoạn sau:

PHP:

Function GetRowColumnArray2D(ByVal arSrc, ByVal index As Long, Optional ByVal GetRow As Boolean = True)
''arSrc: Mang 2 chieu
''index: Chi so dong hoac cot can lay du lieu
''GetRow: Mac dinh lay theo dong, nguoc lai =False thi lay theo cot
    Dim Result(), i As Long, j As Long, d As Long
    d = IIf(GetRow = True, 2, 1)
    For i = LBound(arSrc, d) To UBound(arSrc, d)
        If GetRow = True Then
            ReDim Preserve Result(j)
            Result(j) = arSrc(index, i)
            j = j + 1
        Else
            ReDim Preserve Result(j)
            Result(j) = arSrc(i, index)
            j = j + 1
        End If
    Next i
    GetRowColumnArray2D = Result
End Function

NguyenNgocThuHien · 18/10/17

befaint đã viết:
Không được. Bạn thử đi...

Mã:

Sub kk()
    Dim c
    Dim a(1 To 3, 1 To 3) As Variant
    Dim i, j
    Dim k
    For i = LBound(a, 2) To UBound(a, 2)
        For j = LBound(a, 1) To UBound(a, 1)
            
            
            k = k + 1
            a(j, i) = k
        Next
    Next
    Range("a1:c3").Value = a
    c = Application.Index(a, 2) 'hang 2
    
    Range("d1:f1").Value = c
    c = Application.Index(a, , 3) 'cot 3
    Range("h1:h3").Value = c
End Sub

Đối với cột thì có thể dùng api, nhưng chưa thử.

befaint · 18/10/17

NguyenNgocThuHien đã viết:
c = Application.Index(a, 2) 'hang 2

Kết quả là mảng 1 chiều.

NguyenNgocThuHien đã viết:
c = Application.Index(a, , 3) 'cot 3

Kết quả là mảng 2 chiều. Thử thêm Transpose vào được không?

NguyenNgocThuHien đã viết:
Đối với cột thì có thể dùng api

Vậy ta làm luôn đi.

tueyennhi · 19/10/17

em có mảng sau KHR(r1, 1) = HR(i, 2)

'(1)
Range("A5")= KHR(r1, 1)

Làm thế nào để biến cái "dọc" này thành ngang??

Giả sử kết quả mảng đó có các phần tử tại dòng 1, 2 và 3 là 10, 11 và 12, cột là cột 1. Vậy làm thế nào để chuyển hóa cái "dòng dọc" này thành dòng "ngang"?

Hay nói cách khác em muốn kết quả thể hiện tại 1(1) lần lượt là :A5 là 10, A6 là 11 và A7 là 12

NguyenNgocThuHien · 19/10/17

befaint đã viết:
Kết quả là mảng 1 chiều.

Kết quả là mảng 2 chiều. Thử thêm Transpose vào được không?

Vậy ta làm luôn đi.

Mã:

 Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Sub kk()
    Dim c
    Dim a(1 To 3, 1 To 3) As Variant
    Dim kq() As Variant
    
    
    
    
    Dim i, j
    Dim k
    For i = LBound(a, 2) To UBound(a, 2)
        For j = LBound(a, 1) To UBound(a, 1)
            
            
            k = k + 1
            a(j, i) = k
        Next
    Next
    Range("a1:c3").Value = a
    c = Application.Index(a, 2) 'hang 2
    
    ReDim kq(1 To 3)
    
    'CopyMemory kq(1), c(1, 1), 16 * 3&
    
    Range("d1:f1").Value = c
    c = Application.Index(a, , 3) 'cot 3
    CopyMemory kq(1), c(1, 1), 16 * 3&
    
    Range("h1:h3").Value = kq
End Sub

anhtuanle123 · 20/10/17

hàm CopyMemory hay đó , có thể dùng nó như kiểu con trỏ đến bộ nhớ trong c vậy !^^

tueyennhi · 27/11/17

Anh chị giúp em với, file rõ ràng không có phần tử nào trong mảng mà khi chạy code trong file nó báo đến tận dòng 1048572.

ndu96081631 · 27/11/17

tueyennhi đã viết:
Anh chị giúp em với, file rõ ràng không có phần tử nào trong mảng mà khi chạy code trong file nó báo đến tận dòng 1048572.

Từ dòng 5 trở đi có dữ liệu đâu? Vì thế mà Range("B5").End(xlDown)) sẽ nằm ở dòng thứ 1048576

tueyennhi · 27/11/17

ndu96081631 đã viết:
Từ dòng 5 trở đi có dữ liệu đâu? Vì thế mà Range("B5").End(xlDown)) sẽ nằm ở dòng thứ 1048576

À như vậy ít nhất em phải có dữ liệu ở B5 và B6. Cảm ơn thầy nhé!

ndu96081631 · 27/11/17

tueyennhi đã viết:
À như vậy ít nhất em phải có dữ liệu ở B5 và B6. Cảm ơn thầy nhé!

Thường để an toàn ít ai dùng End(xlDown) mà nên End(xlUp) cho chắc

Hoang2013 · 27/11/17

Nên xài End(xlDown) trong các trường hợp CSDL hợp chuẩn & tất nhiên trong nhiều trường hợp sẽ nhanh hơn là End(xlUp)

tueyennhi · 28/11/17

Xem giúp em code này sai ở đâu với. Điều kiện là tại ô check nếu không có dữ liệu thì điền ID vào cột ID và giá trị "N" vào ngày tương ứng sang sheet Chinh. Em kiểm tra rất kỹ rồi mà không tài nào phát hiện ra cái sai.

tueyennhi · 28/11/17

hpkhuong đã viết:
dArr(1 To 10000, 1 To 35) -> 35 cột
sArr = Range("J6", Range("J65000").End(xlUp)).Resize(, 125).Value -> 125 cột

J chạy từ cột 2 tới cột cuối của mảng sArr (tức 125)

==> Mảng dArr bị té ghế

À vậy em sửa lại như sau:

PHP:

Public Sub Loc_nghi()
Dim dic As Object, Ws As Worksheet, Tem As String, Rws As Long
Dim i As Long, j As Long, K As Long, C As Long
Dim sArr(), dArr(1 To 20000, 1 To 2000)
sArr = Range("J6", Range("J65000").End(xlUp)).Resize(, 125).Value
For i = 3 To UBound(sArr, 1)
    For j = 2 To 117 Step 4
        If Weekday(sArr(1, j)) <> 1 Then
            If IsEmpty(sArr(i, j)) Then
                K = K + 1
                dArr(K, 1) = sArr(i, 1)
                dArr(K, K + 1) = "N"
            End If
        End If
    Next j
Next i
Sheets("Chinh").Range("A2").Resize(K, 32) = dArr
End Sub

Mà vẫn không được

tueyennhi · 28/11/17

hpkhuong đã viết:
Túm lại đừng vội vàng... Ông bà ta nói "Chưa học bò chớ lo học chạy". Tìm hiểu về vòng lặp, Step rồi hỡ phát biểu...

Ôi anh ơi giúp em với em đang check công mà làm thủ công lâu quá nên vội lên diễn đàn hỏi. Điều kiện của em muốn lọc những ai không có công, có các dữ liệu nghỉ (ô trống tại cột công các ngày) thì chuyển sang sheet Chính là N (Nghỉ không lý do).

Em hiểu là cái K của em đang có vấn đề vì mỗi vòng lặp j thỏa mãn thì K + 1. Như vậy kết quả có ra thì cũng thành một dãy ID trùng nhau nhưng em chưa biết đặt K ở đâu cho đúng. Mong mọi người giúp đỡ!

Gió Đông · 28/11/17

tueyennhi đã viết:

À vậy em sửa lại như sau:

PHP:

Public Sub Loc_nghi()
Dim dic As Object, Ws As Worksheet, Tem As String, Rws As Long
Dim i As Long, j As Long, K As Long, C As Long
Dim sArr(), dArr(1 To 20000, 1 To 2000)
sArr = Range("J6", Range("J65000").End(xlUp)).Resize(, 125).Value
For i = 3 To UBound(sArr, 1)
    For j = 2 To 117 Step 4
        If Weekday(sArr(1, j)) <> 1 Then
            If IsEmpty(sArr(i, j)) Then
                K = K + 1
                dArr(K, 1) = sArr(i, 1)
                dArr(K, K + 1) = "N"
            End If
        End If
    Next j
Next i
Sheets("Chinh").Range("A2").Resize(K, 32) = dArr
End Sub

Mà vẫn không được

Không được là không được cái gì=?

Gió Đông · 28/11/17

Võ đoán đại, sử dụng tạm cái này

PHP:

Public Sub Loc_nghi()
    Dim i As Long, j As Long, k As Long
    Dim sArr(), dArr(), OK As Boolean
   
    sArr = Range("J6", Range("J65000").End(xlUp)).Resize(, 125).Value
    ReDim dArr(1 To UBound(sArr), 32)
   
    k = 1 'Row tieu de ngay
    For j = 2 To 125 Step 4
        dArr(k, 2 + (j - 2) \ 4) = sArr(1, j)
    Next j
   
    For i = 3 To UBound(sArr, 1)
        OK =True
        For j = 2 To 125 Step 4
            If Weekday(sArr(1, j)) <> 1 Then
                If IsEmpty(sArr(i, j)) Then
                    If  OK Then
                        OK = False
                        k = k + 1
                        dArr(k, 1) = sArr(i, 1)
                    End If
                    dArr(k, 2 + (j - 2) \ 4) = "N"
                End If
            End If
        Next j
    Next i
   
    Sheets("Chinh").Range("A2").Resize(k, 32) = dArr
    Sheets("Chinh").Activate
End Sub

tueyennhi · 29/11/17

Gió Đông đã viết:

Võ đoán đại, sử dụng tạm cái này

PHP:

Public Sub Loc_nghi()
    Dim i As Long, j As Long, k As Long
    Dim sArr(), dArr(), OK As Boolean
 
    sArr = Range("J6", Range("J65000").End(xlUp)).Resize(, 125).Value
    ReDim dArr(1 To UBound(sArr), 32)
 
    k = 1 'Row tieu de ngay
    For j = 2 To 125 Step 4
        dArr(k, 2 + (j - 2) \ 4) = sArr(1, j)
    Next j
 
    For i = 3 To UBound(sArr, 1)
        OK =True
        For j = 2 To 125 Step 4
            If Weekday(sArr(1, j)) <> 1 Then
                If IsEmpty(sArr(i, j)) Then
                    If  OK Then
                        OK = False
                        k = k + 1
                        dArr(k, 1) = sArr(i, 1)
                    End If
                    dArr(k, 2 + (j - 2) \ 4) = "N"
                End If
            End If
        Next j
    Next i
 
    Sheets("Chinh").Range("A2").Resize(k, 32) = dArr
    Sheets("Chinh").Activate
End Sub

Giờ mới có thời gian trả lời bạn. Cảm ơn bạn nhé, code đáp ứng đúng mong muốn của mình

.
Cái OK As Boolean hay nhưng mà vẫn luống cuống khi sử dụng nó. Các tháng sau nhờ có bạn mà công việc lại thêm suôn sẻ rồi

dephetnoi · 22/12/17

Có ai quan tâm bài này nữa không ạ? em đang loay hoay để chuyển cái code sang mảng mà làm mãi không được, code không báo lỗi nhưng lại không giống như cái mà em làm bằng code thường ạ? Bác nào chỉ giúp em với em cũng mới bập bẹ làm quen với VBa thôi ạ

befaint · 22/12/17

dephetnoi đã viết:
Có ai quan tâm bài này nữa không

Không!

------
Mình đọc lý thuyết rồi tự điều chỉnh xem, chứ xem file trên chịu luôn...

dephetnoi · 22/12/17

hiii, muốn code nhanh hơn thôi vì dữ liệu nhiều nó chạy nặng quá bạn ạ. Có cao thủ nào giúp em với em sửa cái code này mà chạy vẫn không đúng code thường :
Sub diennhancong1()
Dim arr()
Dim sarray As Variant
Dim i As Long
Dim j As Long
Range("j8:ae" & Range("kttd1").Row).ClearContents
sarray = Range("a7:z" & Range("kttd1").Row).Value
ReDim arr(1 To UBound(sarray), 1 To UBound(sarray, 2))
For i = 1 To UBound(sarray, 1)
For j = 1 To UBound(sarray, 2)
If arr(7, j) - arr(i, 5) < 6 And arr(7, j) - arr(i, 5) >= 0 And arr(i, 1) <> "HM" Then
arr(i, j ) = "[" & arr(i, 8) & " NC]"
With arr(i, j + arr(i, 4)).Font
.Name = "Times New Roman"
.Size = 10
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End If
Next
Next
Range("j8").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub

dephetnoi · 22/12/17

Em sửa lại cái này nhưng nó chạy bỏ qua 2 dòng không hiểu vì sao ạ?
Sub diennhancong1()
Dim arr()
Dim sarray As Variant
Dim i As Long
Dim j As Long
Range("i8:ae" & Range("kttd1").Row).ClearContents
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
sarray = Range("a8:z" & Range("kttd1").Row - 1).Value
ReDim arr(1 To UBound(sarray), 1 To UBound(sarray, 2))
For i = 1 To UBound(sarray, 1)
For j = 1 To UBound(sarray, 2)
'arr(i, j).ClearContents
If Cells(7, j).Value - Cells(i + 7, 5).Value < 6 And Cells(7, j).Value - Cells(i + 7, 5).Value >= 0 And Cells(i + 7, 1).Value <> "HM" Then
arr(i, j - 8) = "[" & Cells(i + 7, 8) & " NC]"
With arr(i, j).Font
.Name = "Times New Roman"
.Size = 10
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End If
Range("j8:z" & Range("kttd1").Row - 1).Value = arr()
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

tamtam333 · 22/12/17

dephetnoi đã viết:
Có ai quan tâm bài này nữa không ạ? em đang loay hoay để chuyển cái code sang mảng mà làm mãi không được, code không báo lỗi nhưng lại không giống như cái mà em làm bằng code thường ạ? Bác nào chỉ giúp em với em cũng mới bập bẹ làm quen với VBa thôi ạ

Lập riêng chủ đề đi cho rõ ràng, và cần viết chi tiết - để vào cái chủ đề hũ lút này thì sao mà quan tâm

dephetnoi · 23/12/17

Miình làm được rồi bạn ạ, tốc độ cải thiện lên đáng kể với cùng 1 dữ liệu, cảm ơn các bạn đã quan tâm ạ

tueyennhi · 13/1/18

Cho em hỏi trong mảng khi dùng vòng lặp For (Giả sử For i = 1 to 10). Vậy có cách nào để nếu lỗi thì nó sẽ báo lỗi đang ở i thứ bao nhiêu không? Em dùng lệnh
On Error GoTo Loi
.
.
.
Loi: Msgobx i
Thì không được như mong muốn, nó báo hết Msgbox từ 1 đến 10. Em tưởng khi lỗi nó mới nhảy đến dòng Loi để đưa ra giá trị i chứ nhỉ.

NguyenNgocThuHien · 13/1/18

tueyennhi đã viết:
Cho em hỏi trong mảng khi dùng vòng lặp For (Giả sử For i = 1 to 10). Vậy có cách nào để nếu lỗi thì nó sẽ báo lỗi đang ở i thứ bao nhiêu không? Em dùng lệnh
On Error GoTo Loi
.
.
.
Loi: Msgobx i
Thì không được như mong muốn, nó báo hết Msgbox từ 1 đến 10. Em tưởng khi lỗi nó mới nhảy đến dòng Loi để đưa ra giá trị i chứ nhỉ.

Code đưa thiếu.

on error goto loi

for i.....

next i

exit sub

loi:

msgbox i

Đại loại như vậy.

phuongxd269 · 9/3/18

Mình mới thực hành VBA đc vài hôm thì gặp vấn đề này chắc phải dùng Array và Dictionary. Phần mềm xuất nội lực ra ở nhiều tiết diện trên dầm và ở nhiều tổ hợp khác nhau nhưng mình chỉ muốn lấy 3 giá trị nội lực: 2 giá trị nhỏ nhất ở 2 đầu dầm( giá trị âm lớn nhất), 1 giá trị lớn nhất ở giữa dầm ( giá trị + , không phân biệt vị trí, cứ lớn nhất là lấy). Mình định lọc từng cái 1 để ghép thành mảng hoàn chỉnh xongdùng soft data. Nhưng làm với tiết diện đầu dầm trái thì Code chạy không chuẩn. Mọi người xem dùm lỗi ở đâu! Do bận nên không có nhiều thời gian thực hành nhiều bài nên mong mọi người chỉ giúp! Thank!

themorzer · 5/4/18

code sau dây khi đưa vào list box thì chỉ hiện 1 cột, mình muốn xuất ra theo nhiều cột

Mã:

Function listterminal1(ltArray, ByVal ter As String)
    Dim dic1 As Object, i As Long, j As Long, TmpArr,
    TmpArr = ltArray
Set dic1 = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(TmpArr)
    If TmpArr(i, 1) = ter Then
        For j = 1 To UBound(TmpArr, 2)
            If TmpArr(i, j) <> Empty Then
          
                dic1.Add TmpArr(i, j), ""
      
            End If
        Next j
    End If
Next i
listterminal1 = dic1.Keys
End Function
[code]
không biết mảng trên có vấn đề j mong mọi người giúp

ndu96081631 · 5/4/18

themorzer đã viết:

code sau dây khi đưa vào list box thì chỉ hiện 1 cột, mình muốn xuất ra theo nhiều cột

Mã:

Function listterminal1(ltArray, ByVal ter As String)
    Dim dic1 As Object, i As Long, j As Long, TmpArr,
    TmpArr = ltArray
Set dic1 = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(TmpArr)
    If TmpArr(i, 1) = ter Then
        For j = 1 To UBound(TmpArr, 2)
            If TmpArr(i, j) <> Empty Then
         
                dic1.Add TmpArr(i, j), ""
     
            End If
        Next j
    End If
Next i
listterminal1 = dic1.Keys
End Function
[code]
không biết mảng trên có vấn đề j mong mọi người giúp

Nạp dic.keys vào ListBox đương nhiên nó chỉ ra kết quả 1 cột rồi. Muốn nhiều cột phải cho kết quả vào mảng 2 chiều, xong gán mảng 2 chiều ấy vào listBox

themorzer · 5/4/18

ndu96081631 đã viết:
Nạp dic.keys vào ListBox đương nhiên nó chỉ ra kết quả 1 cột rồi. Muốn nhiều cột phải cho kết quả vào mảng 2 chiều, xong gán mảng 2 chiều ấy vào listBox

Do e cứ tưởng chạy 2 vòng lặp là mảng 2 chiều chứ. Vậy mình sử dụng redim hay hàm gì vậy thầy

ndu96081631 · 6/4/18

themorzer đã viết:
Do e cứ tưởng chạy 2 vòng lặp là mảng 2 chiều chứ. Vậy mình sử dụng redim hay hàm gì vậy thầy

Tôi sửa hàm của bạn lại 1 chút:

Mã:

Function listterminal1(ByVal ltArray, ByVal ter)
  'ltArray phải là 1 mảng 2 chiều
  Dim aDes, aTmp
  Dim lR As Long, lC As Long, idx As Long
  Dim lUB1 As Long, lUB2 As Long, lLB1 As Long, lLB2 As Long
  aTmp = ltArray
  lLB1 = LBound(aTmp, 1): lUB1 = UBound(aTmp, 1)
  lLB2 = LBound(aTmp, 2): lUB2 = UBound(aTmp, 2)
  ReDim aDes(lLB1 To lUB1, lLB2 To lUB2)
  For lR = lLB1 To lUB1
    If aTmp(lR, 1) = ter Then
      idx = idx + 1
      For lC = lLB2 To lUB2
        aDes(idx + lLB1 - 1, lC) = aTmp(lR, lC)
      Next
    End If
  Next
  If idx Then listterminal1 = aDes
End Function

Bạn xem file ví dụ mẫu để biết cách áp dụng

themorzer · 6/4/18

ndu96081631 đã viết:

Tôi sửa hàm của bạn lại 1 chút:

Mã:

Function listterminal1(ByVal ltArray, ByVal ter)
  'ltArray phải là 1 mảng 2 chiều
  Dim aDes, aTmp
  Dim lR As Long, lC As Long, idx As Long
  Dim lUB1 As Long, lUB2 As Long, lLB1 As Long, lLB2 As Long
  aTmp = ltArray
  lLB1 = LBound(aTmp, 1): lUB1 = UBound(aTmp, 1)
  lLB2 = LBound(aTmp, 2): lUB2 = UBound(aTmp, 2)
  ReDim aDes(lLB1 To lUB1, lLB2 To lUB2)
  For lR = lLB1 To lUB1
    If aTmp(lR, 1) = ter Then
      idx = idx + 1
      For lC = lLB2 To lUB2
        aDes(idx + lLB1 - 1, lC) = aTmp(lR, lC)
      Next
    End If
  Next
  If idx Then listterminal1 = aDes
End Function

Bạn xem file ví dụ mẫu để biết cách áp dụng

chương trình của em khi add code này vòa, thì listbox có xuất hiện những dòng rỗng, đã chạy được code, nhưng khi chạy thêm giá trị (click checkbox - giá trị ban dầu không check box thì chạy ok)không có trong mảng thì xuất hiện lỗi

nên em muốn đặt 1 msgbox để link tới Useform nhập liệu

truongvu317 · 6/4/18

themorzer đã viết:
chương trình của em khi add code này vòa, thì listbox có xuất hiện những dòng rỗng, đã chạy được code, nhưng khi chạy thêm giá trị (click checkbox - giá trị ban dầu không check box thì chạy ok)không có trong mảng thì xuất hiện lỗi

nên em muốn đặt 1 msgbox để link tới Useform nhập liệu

ÍT ra cũng phải mô tả qua chức năng của cái form, các control dùng để làm gì, Chụp hình lỗi thì cũng chả chịu kể về việc nó lỗi như thế nào. Xem code chỉ thấy buồn ngủ mới hay chứ.

themorzer · 6/4/18

ndu96081631 đã viết:

Tôi sửa hàm của bạn lại 1 chút:

Mã:

Function listterminal1(ByVal ltArray, ByVal ter)
  'ltArray phải là 1 mảng 2 chiều
  Dim aDes, aTmp
  Dim lR As Long, lC As Long, idx As Long
  Dim lUB1 As Long, lUB2 As Long, lLB1 As Long, lLB2 As Long
  aTmp = ltArray
  lLB1 = LBound(aTmp, 1): lUB1 = UBound(aTmp, 1)
  lLB2 = LBound(aTmp, 2): lUB2 = UBound(aTmp, 2)
  ReDim aDes(lLB1 To lUB1, lLB2 To lUB2)
  For lR = lLB1 To lUB1
    If aTmp(lR, 1) = ter Then
      idx = idx + 1
      For lC = lLB2 To lUB2
        aDes(idx + lLB1 - 1, lC) = aTmp(lR, lC)
      Next
    End If
  Next
  If idx Then listterminal1 = aDes
End Function

Bạn xem file ví dụ mẫu để biết cách áp dụng

truongvu317 đã viết:
ÍT ra cũng phải mô tả qua chức năng của cái form, các control dùng để làm gì, Chụp hình lỗi thì cũng chả chịu kể về việc nó lỗi như thế nào. Xem code chỉ thấy buồn ngủ mới hay chứ.

chương trình dò tìm nvl. Phần rẽ Textbox nhập Partcode. Trong listbox sẽ hiện ra giá trị mình muốn tìm. Sau khi chọn xong click vào cbb wire type chọn 1 giá trị và wire size chọn 1 giá trị (2 giá trị này kết hợp lại sẽ là tiêu đề của cột trong sheet terminal.
Trong listbox hiện giá trị sẽ chọn cột 9 và cột này lấy giá trị ứng với các dòng của cột đầu trong sheet terminal
Sau khi chọn xong sẽ được 1 giá trị. Giá trị này tiếp tục đc đo tìm ở sheet5 nhằm lấy partcode, partname, và maker để hiện lên lb_terminal.
Nhưng khi check vô checkbox Sn hoặc au thì xuất hiện lỗi trên. Lỗi trên mình đoán là giá trị sau khi nối thêm chuỗi thi giá trị này k trùng cột partname trong sheet5.
Nên mình muốn tại một msgbox nhằm báo lỗi rỗng để gọi useform nhập liệu lên để nhập vào k cho Thoòng báo lỗi này nữa

themorzer · 6/4/18

themorzer đã viết:
chương trình dò tìm nvl. Phần rẽ Textbox nhập Partcode. Trong listbox sẽ hiện ra giá trị mình muốn tìm. Sau khi chọn xong click vào cbb wire type chọn 1 giá trị và wire size chọn 1 giá trị (2 giá trị này kết hợp lại sẽ là tiêu đề của cột trong sheet terminal.
Trong listbox hiện giá trị sẽ chọn cột 9 và cột này lấy giá trị ứng với các dòng của cột đầu trong sheet terminal
Sau khi chọn xong sẽ được 1 giá trị. Giá trị này tiếp tục đc đo tìm ở sheet5 nhằm lấy partcode, partname, và maker để hiện lên lb_terminal.
Nhưng khi check vô checkbox Sn hoặc au thì xuất hiện lỗi trên. Lỗi trên mình đoán là giá trị sau khi nối thêm chuỗi thi giá trị này k trùng cột partname trong sheet5.
Nên mình muốn tại một msgbox nhằm báo lỗi rỗng để gọi useform nhập liệu lên để nhập vào k cho xảy ra lỗi này

duynguyenkk · 13/4/18

Em có bài toán tổng hợp vật tư theo từng loại dựa vào Đơn vị để tổng hợp từng loại vật tư
Em mới tập tành khai báo như dưới có đúng không

Mã:

Dim n As Long, m As Long
    rng1 as range,rng2 as range, cll1 as range
        Arr As Variant
   
rng1 = .range("K8:K65000").End(xlUp).value
rng2 = .range("O8:O65000") .End(xlUp).value
m = sheet3.Range("K65000").End(xlUp).Row
'Kiem tra du lieu trong sheet "TLuong DT" neu co thi loc
 if m>8 then
            sheet3.select

nhờ các anh chị xem giúp em với

♫ђöล♥ßล†♥†µ♫ · 14/4/18

Anh chị cho em hỏi thêm về phương thức ReDim Preserve với ạ:
Em có 1 Code để chuyển từ hàng sang cột và dùng ReDim Preserve để tăng kích thước chiều thứ 2 của mảng

PHP:

Public Sub Chuyendulieu()
    Dim Dic As Object, Tem As String, Tam, Col As Long, R As Long
    Dim sArr(), tArr(), I As Long, K As Long
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range("A2", Range("B" & Rows.Count).End(3)).Value
Col = 2
ReDim tArr(1 To UBound(sArr), 1 To Col)
ReDim Tam(1 To UBound(sArr), 1 To 1)
For I = 1 To UBound(sArr, 1)
    If sArr(I, 1) <> Empty Then
        Tem = sArr(I, 1)
        If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, K
            tArr(K, 1) = Tem: tArr(K, 2) = sArr(I, 2): Tam(K, 1) = 2
        Else
            R = Dic.Item(Tem): Tam(R, 1) = Tam(R, 1) + 1
            If Col < Tam(R, 1) Then
                Col = Tam(R, 1)
                If Col > Columns.Count Then Exit Sub
                ReDim Preserve tArr(1 To UBound(sArr), 1 To Col)
            End If
            tArr(R, Tam(R, 1)) = sArr(I, 2)
        End If
    End If
Next I
Range("J2").Resize(K, UBound(tArr, 2)) = tArr
Set Dic = Nothing
End Sub

Nhưng khi Col=404 thì báo lỗi Out of Memory
Vậy Anh (Chị ) cho em hỏi kích thước chiều 2 nhận được tối đa là bao nhiêu không ạ
Em cám ơn Anh (Chị nhiều)

HieuCD · 14/4/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Anh chị cho em hỏi thêm về phương thức ReDim Preserve với ạ:
Em có 1 Code để chuyển từ hàng sang cột và dùng ReDim Preserve để tăng kích thước chiều thứ 2 của mảng

PHP:

Public Sub Chuyendulieu() Dim Dic As Object, Tem As String, Tam, Col As Long, R As Long Dim sArr(), tArr(), I As Long, K As Long Set Dic = CreateObject("Scripting.Dictionary") sArr = Range("A2", Range("B" & Rows.Count).End(3)).Value Col = 2 ReDim tArr(1 To UBound(sArr), 1 To Col) ReDim Tam(1 To UBound(sArr), 1 To 1) For I = 1 To UBound(sArr, 1) If sArr(I, 1) <> Empty Then Tem = sArr(I, 1) If Not Dic.Exists(Tem) Then K = K + 1 Dic.Add Tem, K tArr(K, 1) = Tem: tArr(K, 2) = sArr(I, 2): Tam(K, 1) = 2 Else R = Dic.Item(Tem): Tam(R, 1) = Tam(R, 1) + 1 If Col < Tam(R, 1) Then Col = Tam(R, 1) If Col > Columns.Count Then Exit Sub ReDim Preserve tArr(1 To UBound(sArr), 1 To Col) End If tArr(R, Tam(R, 1)) = sArr(I, 2) End If End If Next I Range("J2").Resize(K, UBound(tArr, 2)) = tArr Set Dic = Nothing End Sub

Nhưng khi Col=404 thì báo lỗi Out of Memory
Vậy Anh (Chị ) cho em hỏi kích thước chiều 2 nhận được tối đa là bao nhiêu không ạ
Em cám ơn Anh (Chị nhiều)

Hỏi anh nầy
http://www.giaiphapexcel.com/diendan/threads/bài-10-array.130807/#post-822190

befaint · 14/4/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Nhưng khi Col=404 thì báo lỗi Out of Memory
Vậy Anh (Chị ) cho em hỏi kích thước chiều 2 nhận được tối đa là bao nhiêu không ạ

- Bạn đọc từ bài #847 nhé.
- Khi truyền mảng xuống bảng tính thì cần chú ý tới kích thước của mảng đó so với kích thước của bảng tính.

ndu96081631 · 14/4/18

befaint đã viết:
- Bạn đọc từ bài #847 nhé.
- Khi truyền mảng xuống bảng tính thì cần chú ý tới kích thước của mảng đó so với kích thước của bảng tính.

Vậy cụ thể mình phải sửa sao cho hết lỗi?

truongvu317 · 14/4/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Anh chị cho em hỏi thêm về phương thức ReDim Preserve với ạ:
Em có 1 Code để chuyển từ hàng sang cột và dùng ReDim Preserve để tăng kích thước chiều thứ 2 của mảng

PHP:

Public Sub Chuyendulieu() Dim Dic As Object, Tem As String, Tam, Col As Long, R As Long Dim sArr(), tArr(), I As Long, K As Long Set Dic = CreateObject("Scripting.Dictionary") sArr = Range("A2", Range("B" & Rows.Count).End(3)).Value Col = 2 ReDim tArr(1 To UBound(sArr), 1 To Col) ReDim Tam(1 To UBound(sArr), 1 To 1) For I = 1 To UBound(sArr, 1) If sArr(I, 1) <> Empty Then Tem = sArr(I, 1) If Not Dic.Exists(Tem) Then K = K + 1 Dic.Add Tem, K tArr(K, 1) = Tem: tArr(K, 2) = sArr(I, 2): Tam(K, 1) = 2 Else R = Dic.Item(Tem): Tam(R, 1) = Tam(R, 1) + 1 If Col < Tam(R, 1) Then Col = Tam(R, 1) If Col > Columns.Count Then Exit Sub ReDim Preserve tArr(1 To UBound(sArr), 1 To Col) End If tArr(R, Tam(R, 1)) = sArr(I, 2) End If End If Next I Range("J2").Resize(K, UBound(tArr, 2)) = tArr Set Dic = Nothing End Sub

Nhưng khi Col=404 thì báo lỗi Out of Memory
Vậy Anh (Chị ) cho em hỏi kích thước chiều 2 nhận được tối đa là bao nhiêu không ạ
Em cám ơn Anh (Chị nhiều)

Chả hiểu nó là cái giống gì nữa, phải nói yêu cầu người khác mới biết đường mà tìm chứ. Tui chỉ gợi ý cái ReDim Preserve thôi, cái này đại kỵ khi dùng, phải rất thạo mới dúng nhé, mỗi lần redim máy tính nó lại cấp phát bộ nhớ mới, và đống công việc khác sẽ được thực hiện, Preserve thì khỏi phải nói. Nó lại đi copy dữ liệu loạn lện, chốt lại mà nói code chạy chậm ngang rùa bò ( thực tế đã chứng mình cái file này của bạn nó chạy chấm quá trời quá đất)
"Nghẹn ngào tôi nghe như trời đất vỡ
Xót xa phố phường, ôi dâng bao căm hờn "

truongvu317 · 14/4/18

ndu96081631 đã viết:
Vậy cụ thể mình phải sửa sao cho hết lỗi?

Thay đổi thuật toán chứ sao? Mà chả hiểu người ta dùng cái exit sub để làm cái gì cơ chứ, thoát sub, mọi thứ như không.

befaint · 14/4/18

ndu96081631 đã viết:
Vậy cụ thể mình phải sửa sao cho hết lỗi?

Sửa như nào thì em chịu rồi.

AutoReply · 14/4/18

befaint đã viết:
Sửa như nào thì em chịu rồi.

Anh đừng khiêm tốn nữa. Em biết anh làm được mà, chịu khó giúp em với. $-\\/.$

HieuCD · 14/4/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Anh chị cho em hỏi thêm về phương thức ReDim Preserve với ạ:
Em có 1 Code để chuyển từ hàng sang cột và dùng ReDim Preserve để tăng kích thước chiều thứ 2 của mảng

PHP:

Public Sub Chuyendulieu() Dim Dic As Object, Tem As String, Tam, Col As Long, R As Long Dim sArr(), tArr(), I As Long, K As Long Set Dic = CreateObject("Scripting.Dictionary") sArr = Range("A2", Range("B" & Rows.Count).End(3)).Value Col = 2 ReDim tArr(1 To UBound(sArr), 1 To Col) ReDim Tam(1 To UBound(sArr), 1 To 1) For I = 1 To UBound(sArr, 1) If sArr(I, 1) <> Empty Then Tem = sArr(I, 1) If Not Dic.Exists(Tem) Then K = K + 1 Dic.Add Tem, K tArr(K, 1) = Tem: tArr(K, 2) = sArr(I, 2): Tam(K, 1) = 2 Else R = Dic.Item(Tem): Tam(R, 1) = Tam(R, 1) + 1 If Col < Tam(R, 1) Then Col = Tam(R, 1) If Col > Columns.Count Then Exit Sub ReDim Preserve tArr(1 To UBound(sArr), 1 To Col) End If tArr(R, Tam(R, 1)) = sArr(I, 2) End If End If Next I Range("J2").Resize(K, UBound(tArr, 2)) = tArr Set Dic = Nothing End Sub

Nhưng khi Col=404 thì báo lỗi Out of Memory
Vậy Anh (Chị ) cho em hỏi kích thước chiều 2 nhận được tối đa là bao nhiêu không ạ
Em cám ơn Anh (Chị nhiều)

Code viết dài chạy nhanh hơn code ngắn

Mã:

Public Sub Chuyendulieu()
  Dim Dic As Object, key As String, sArr As Variant, Arr As Variant, tArr As Variant
  Dim i As Long, k As Long, ik As Long, Col As Long, jmax As Long
 
  Set Dic = CreateObject("Scripting.Dictionary")
  sArr = Range("A2", Range("B" & Rows.Count).End(3)).Value
  ReDim tArr(1 To UBound(sArr), 1 To 2)
  For i = 1 To UBound(sArr, 1)
    If sArr(i, 1) <> Empty Then
      key = sArr(i, 1)
      If Not Dic.Exists(key) Then
        k = k + 1
        Dic.Add key, k
        tArr(k, 1) = key: tArr(k, 2) = 2
      Else
        ik = Dic.Item(key)
        Col = tArr(ik, 2) + 1
        tArr(ik, 2) = Col
      End If
      If jmax < Col Then jmax = Col
    End If
  Next i
  ReDim Arr(1 To k, 1 To jmax)
  For i = 1 To k
    Arr(i, 1) = tArr(i, 1)
    tArr(i, 2) = 2
  Next i
  For i = 1 To UBound(sArr, 1)
    key = sArr(i, 1)
    If key <> Empty Then
      ik = Dic.Item(key)
      Col = tArr(ik, 2)
      Arr(ik, Col) = sArr(i, 2)
      tArr(ik, 2) = Col + 1
    End If
  Next i
 
  Range("E2").Resize(k, jmax) = Arr
  Set Dic = Nothing
End Sub

Nếu thích thì bạn viết bẩy lổi số cột nhiều hơn số cột của Sheet

ndu96081631 · 14/4/18

truongvu317 đã viết:
Chả hiểu nó là cái giống gì nữa, phải nói yêu cầu người khác mới biết đường mà tìm chứ. Tui chỉ gợi ý cái ReDim Preserve thôi, cái này đại kỵ khi dùng, phải rất thạo mới dúng nhé, mỗi lần redim máy tính nó lại cấp phát bộ nhớ mới, và đống công việc khác sẽ được thực hiện, Preserve thì khỏi phải nói. Nó lại đi copy dữ liệu loạn lện, chốt lại mà nói code chạy chậm ngang rùa bò ( thực tế đã chứng mình cái file này của bạn nó chạy chấm quá trời quá đất)
"Nghẹn ngào tôi nghe như trời đất vỡ
Xót xa phố phường, ôi dâng bao căm hờn "

Thế thì thử thí nghiệm vầy đi
1> Sửa

Mã:

ReDim tArr(1 To UBound(sArr), 1 To Col)

Thành:

Mã:

ReDim tArr(1 To 1000, 1 To 30000)

2> Xóa dòng:

Mã:

ReDim Preserve tArr(1 To UBound(sArr), 1 To Col)

3> Sửa:

Mã:

Range("J2").Resize(K, UBound(tArr, 2)) = tArr

Thành:

Mã:

Range("J2").Resize(K, Col) = tArr

Xong chạy lại code xem sao rồi tính tiếp

♫ђöล♥ßล†♥†µ♫ · 14/4/18

truongvu317 đã viết:
Thay đổi thuật toán chứ sao? Mà chả hiểu người ta dùng cái exit sub để làm cái gì cơ chứ, thoát sub, mọi thứ như không.

Em đầu tiên em nghĩ là cái đó lớn hơn cột trong bảng tính thì thoát thôi. Chứ đâu nghĩ nó ra sự tình này

truongvu317 · 14/4/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Em đầu tiên em nghĩ là cái đó lớn hơn cột trong bảng tính thì thoát thôi. Chứ đâu nghĩ nó ra sự tình này

Tui thấy bạn viết dữ liệu vào cột J thì phải, vậy phép so sánh số cột trong bảng tính với số cột trong mảng cũng không còn chính xác nưa rùi. Nếu viết dữ liệu vào cột A thì còn tạm chấp nhận được, khi bị số cột lớn quá người ta lập trình báo lỗi như thế nào đó chứ không ai lại âm thầm kết thúc thủ tục này.
Theo đó thì phương án của ndu3721 cũng đi theo gió thôi.

♫ђöล♥ßล†♥†µ♫ · 14/4/18

HieuCD đã viết:

Code viết dài chạy nhanh hơn code ngắn

Mã:

Public Sub Chuyendulieu()
  Dim Dic As Object, key As String, sArr As Variant, Arr As Variant, tArr As Variant
  Dim i As Long, k As Long, ik As Long, Col As Long, jmax As Long
 
  Set Dic = CreateObject("Scripting.Dictionary")
  sArr = Range("A2", Range("B" & Rows.Count).End(3)).Value
  ReDim tArr(1 To UBound(sArr), 1 To 2)
  For i = 1 To UBound(sArr, 1)
    If sArr(i, 1) <> Empty Then
      key = sArr(i, 1)
      If Not Dic.Exists(key) Then
        k = k + 1
        Dic.Add key, k
        tArr(k, 1) = key: tArr(k, 2) = 2
      Else
        ik = Dic.Item(key)
        Col = tArr(ik, 2) + 1
        tArr(ik, 2) = Col
      End If
      If jmax < Col Then jmax = Col
    End If
  Next i
  ReDim Arr(1 To k, 1 To jmax)
  For i = 1 To k
    Arr(i, 1) = tArr(i, 1)
    tArr(i, 2) = 2
  Next i
  For i = 1 To UBound(sArr, 1)
    key = sArr(i, 1)
    If key <> Empty Then
      ik = Dic.Item(key)
      Col = tArr(ik, 2)
      Arr(ik, Col) = sArr(i, 2)
      tArr(ik, 2) = Col + 1
    End If
  Next i
 
  Range("E2").Resize(k, jmax) = Arr
  Set Dic = Nothing
End Sub

Nếu thích thì bạn viết bẩy lổi số cột nhiều hơn số cột của Sheet

Cám ơn anh @HieuCD rất nhiều và em cám ơn Chị @truongvu317, và Thầy @ndu96081631
Đúng là ReDim Preserve hôm nay em mới tìm tòi và áp dụng ạ

truongvu317 · 14/4/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Chị @truongvu317,

Định trêu tui chắc.

♫ђöล♥ßล†♥†µ♫ · 14/4/18

truongvu317 đã viết:
Định trêu tui chắc.

Úi. Trước khi trả lời em có vào xem thông tin cá nhân. Rõ ràng là Chị mà

truongvu317 · 14/4/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Úi. Trước khi trả lời em có vào xem thông tin cá nhân. Rõ ràng là Chị mà

Tui là boy và rất dốt tiếng anh, có khi lúc đăng ký n i ck tui chọn sai giới tính cũng nên.

ndu96081631 · 15/4/18

0

truongvu317 đã viết:
Theo đó thì phương án của ndu3721 cũng đi theo gió thôi.

khi có lỗi xuất hiện mà chưa biết lỗi từ đâu, tôi thường thử nghiệm bằng con số cụ thể
Bài ở trên cũng là dạng gợi ý thí nghiệm chứ không phải giải pháp (ai lại ReDim tArr(1 To 1000, 1 To 30000) chứ)
Thí nghiệm... thí nghiệm... và thí nghiệm... để tìm ra chân lý. Cách làm của tôi là vậy (vì xa trường học mà)

truongvu317 · 15/4/18

ndu96081631 đã viết:
0
khi có lỗi xuất hiện mà chưa biết lỗi từ đâu, tôi thường thử nghiệm bằng con số cụ thể
Bài ở trên cũng là dạng gợi ý thí nghiệm chứ không phải giải pháp (ai lại ReDim tArr(1 To 1000, 1 To 30000) chứ)
Thí nghiệm... thí nghiệm... và thí nghiệm... để tìm ra chân lý. Cách làm của tôi là vậy (vì xa trường học mà)

Ý em nói là thuật toán gốc, hay code của bạn ý ngay từ ban đầu đã có sự vộ lý rồi.

Mã:

If Col > Columns.Count Then Exit Sub

Code trên muốn kiểm tra xem số cột mà lớn hơn tổng số cột của sheet thì thoát. số cột tối đa là 16384, giả sử col= 16383, code hoạt động bình thường, nhưng đến lúc đẩy dữ liệu xuống sheet sẽ bị lỗi, vì nhớ rằng dữ liệu được viết tại cột J trở đi chứ không phải là cột A. Cái khó là ở chỗ phải xác định được số cột cần thiết, rồi redim một phát là sẽ được. Cho 2 vòng lặp, một vòng dùng để tính col cần thiết, một vòng để copy dữ liệu là xong,

PS: Cha nội này nghịch vừa thôi, kêu redim mảng lớn thế là teo máy của người ta cũng nên.

themorzer · 13/6/18

ndu96081631 đã viết:

Tôi sửa hàm của bạn lại 1 chút:

Mã:

Function listterminal1(ByVal ltArray, ByVal ter)
  'ltArray phải là 1 mảng 2 chiều
  Dim aDes, aTmp
  Dim lR As Long, lC As Long, idx As Long
  Dim lUB1 As Long, lUB2 As Long, lLB1 As Long, lLB2 As Long
  aTmp = ltArray
  lLB1 = LBound(aTmp, 1): lUB1 = UBound(aTmp, 1)
  lLB2 = LBound(aTmp, 2): lUB2 = UBound(aTmp, 2)
  ReDim aDes(lLB1 To lUB1, lLB2 To lUB2)
  For lR = lLB1 To lUB1
    If aTmp(lR, 1) = ter Then
      idx = idx + 1
      For lC = lLB2 To lUB2
        aDes(idx + lLB1 - 1, lC) = aTmp(lR, lC)
      Next
    End If
  Next
  If idx Then listterminal1 = aDes
End Function

Bạn xem file ví dụ mẫu để biết cách áp dụng

chào thầy em áp dụng code của thầy thì phần Listbox của em xuất hiện thêm dòng rỗng

e muốn chỉ xuất hiện dữ liệu khi khác rỗng, còn nếu rỗng báo lỗi
em có sửa lại code

Mã:

Function listterminal(ByVal sArray, ByVal ter)
  'ltArray phai là 1 mang 2 chieu
  Dim aDes, aTmp
  Dim lR As Long, lC As Long, idx As Long
  Dim lUB1 As Long, lUB2 As Long, lLB1 As Long, lLB2 As Long
  aTmp = sArray
  lLB1 = LBound(aTmp, 1): lUB1 = UBound(aTmp, 1)
  lLB2 = LBound(aTmp, 2): lUB2 = UBound(aTmp, 2)
  ReDim aDes(lLB1 To lUB1, lLB2 To lUB2)
  For lR = lLB1 To lUB1
    If aTmp(lR, 1) = ter Then
      idx = idx + 1
      For lC = lLB2 To lUB2

        If IsEmpty(aTmp(lR, lC)) = False Then

        aDes(idx + lLB1 - 1, lC) = aTmp(lR, lC)
        End If
      Next
    End If
  Next
  If idx Then listterminal = aDes
End Function

để loại bỏ dòng rỗng nhưng vẫn chưa được, mon thầy giúp đỡ

Nam CT · 17/6/18

Chào các anh chị , em có một vấn đề về mảng mong được giúp đỡ:
khi em gán giá trị của một mảng vào một range trong excel, nếu trong trường hợp cột đó đang lọc ( filter) thì sẽ bị lệch dòng. Cho dù đặt tên bảng cũng vậy. Có cách nào để khi đang lọc mà vẫn gán được giá trị của mảng vào bảng không ạ.
Ví dụ như này :
arr = Sheet1.Range("A2:B1000")
Sheet2.Range("bang").Value = arr

tonnydung · 1/7/18

Em đang làm 1 dữ liệu có dùng hàm IF nhưng dữ liệu ít thì không sao giờ dữ liệu nó nhiều lên thì dùng nhiều hàm sẽ rất chậm và có thể Treo nên em hỏi cả nhà em giúp em có cách nào tạo code VBA hàm Array trên Sheet tự động điền thông tin để cho dữ liệu nhẹ đi không ah ?
Em có gửi hình ảnh công thức hàm IF và 1 trong các dữ liệu ở các cột (tât cả các hàng ở cột T,AL,AJ thay đổi thì hàng tương ứng ở cột AN thay đổi theo)

tonnydung · 3/7/18

Em nhờ cả nhà giúp về cái Hà Array tính ngày đến hạn phải thay thế và sửa chữa. Em có gửi File đính kèm.
ở Sheet "KmHangNgay" có thông kê số Km đi hàng ngày của xe. còn ở Sheet KTRA_DENHAN Cột A ghi biển số xe, cột B ghi ngày thay mới đây, cột D là quy định đến bao nhiêu KM sẽ thay, cột E là số Km hiện tại xe đã chạy được bao KM. điều kiện là nếu cột A và B (ở Sheet KTRA_DENHAN) ghi nhận biển số xe mà ngày thay gần nhất là ngày nào thì sẽ Ktra Km tổng từ ngày đó đến nay (VD: ngày 1-5-18 em đã thay dầu thì nó sẽ Ktra tổng Km từ ngày 2-5 ở Sheet KMHangNgay cộng lại nếu đến hoặc vượt quá KM quy định ở cột D là 7000km sẽ thay. Nếu đến nay số Km đã đến 6000km thì cột E hiển thị màu Vàng và hiển thị số tỏng Km từ ngày 2-5 đến nay di duoc bao KM, còn nếu đến 7000km hoặc hơn thì sẽ báo đỏ và cũng hiện thị số Km tổng từ ngày 2-5 đến nay đã đi được) Mục đích em muốn nó tự động báo để mình biết từ ngày thay dầu đến nay thì xe đã đi được bao nhiêu Km và đưa ra quy định bao nhiêu Km sẽ thay nếu đến km thì sẽ báo đỏ để biết. Rất mong được giúp đỡ.

SA_DQ · 3/7/18

Bạn chép macro sự kiện này vô trang 'KemTra_DenHan'

PHP:

Private Sub Worksheet_Activate()
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
 Dim Rws As Long, Ngay As Date, SoKm As Double
 Dim MyAdd As String
 Set Sh = ThisWorkbook.Worksheets("KmHangNgay")
 Rws = Sh.[d1].CurrentRegion.Rows.Count
 Set Rng = Sh.Range("D1").Resize(Rws)
 For Each Cls In Range([A3], [A3].End(xlDown))
    Ngay = Cls.Offset(, 1).Value
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            If sRng.Offset(, -2).Value >= Ngay Then
                SoKm = SoKm + sRng.Offset(, 1).Value
            End If
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
        If SoKm > 0 Then
            Cls.Offset(, 4).Value = SoKm:       SoKm = 0
        End If
    Else
        Cls.Interior.ColorIndex = 35
    End If
 Next Cls
End Sub

tonnydung · 3/7/18

SA_DQ đã viết:

Bạn chép macro sự kiện này vô trang 'KemTra_DenHan'

PHP:

Private Sub Worksheet_Activate()
Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
Dim Rws As Long, Ngay As Date, SoKm As Double
Dim MyAdd As String
Set Sh = ThisWorkbook.Worksheets("KmHangNgay")
Rws = Sh.[d1].CurrentRegion.Rows.Count
Set Rng = Sh.Range("D1").Resize(Rws)
For Each Cls In Range([A3], [A3].End(xlDown))
    Ngay = Cls.Offset(, 1).Value
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            If sRng.Offset(, -2).Value >= Ngay Then
                SoKm = SoKm + sRng.Offset(, 1).Value
            End If
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
        If SoKm > 0 Then
            Cls.Offset(, 4).Value = SoKm:       SoKm = 0
        End If
    Else
        Cls.Interior.ColorIndex = 35
    End If
Next Cls
End Sub

Tks bác nhiều. Nhưng gio em có 3 vấn đề gặp nữa.
1/ Giờ em muốn nếu nhập tiếp ngày thay mới của 1 xe nào đó ở dưới thì nó sẽ chỉ hiển thị Km mới của xe đó ở dưới và ở trên nó sẽ không hiển thị nữa thì có được không ?
2/ EM muốn thêm cả các mục thay Lốp, bảo dưỡng bốn bánh (em có bổ xung thêm vào File mới gửi kèm theo) LƯU Ý ở các mục mới sẽ có 2 điều kiện (1 là Km 2 la ngày đến hạn) nó sẽ báo vào cả 2 cột tương ứng (cột ngày nó sẽ đếm còn bao nhiêu ngày nữa sẽ đến so với ngày hiện tại)
3/ Nếu em muốn thêm vài mục khác nữa cần theo dõi nữa thì em phải thêm vòng lặp ở chỗ nào

SA_DQ · 4/7/18

Nhưng gio em có 3 vấn đề gặp nữa.
1/ Giờ em muốn nếu nhập tiếp ngày thay mới của 1 xe nào đó ở dưới thì nó sẽ chỉ hiển thị Km mới của xe đó ở dưới và ở trên nó sẽ không hiển thị nữa thì có được không ?
2/ EM muốn thêm cả các mục thay Lốp, bảo dưỡng bốn bánh (em có bổ xung thêm vào File mới gửi kèm theo) LƯU Ý ở các mục mới sẽ có 2 điều kiện (1 là Km 2 la ngày đến hạn) nó sẽ báo vào cả 2 cột tương ứng (cột ngày nó sẽ đếm còn bao nhiêu ngày nữa sẽ đến so với ngày hiện tại)
3/ Nếu em muốn thêm vài mục khác nữa cần theo dõi nữa thì em phải thêm vòng lặp ở chỗ nào

(1) Chưa hiểu hết í bạn nên chưa thể làm gì giúp bạn được.

tonnydung · 4/7/18

SA_DQ đã viết:
(1) Chưa hiểu hết í bạn nên chưa thể làm gì giúp bạn được.

Phần 1/ vd: sau het dot 1 báo xong em thay dầu và ghi ngày thay dầu mới của các xe ở dòng tiếp theo (vd: o sheet Denhan. ngay 2/7/18 1 xe đến kỳ và em thay dầu nên em sẽ lại ghi tiếp dữ liệu ở cột A ghi bien so xe cot B ghi ngày thay dầu là 2/7/18 nên em muốn sau khi ghi phía duoi 1 xe nào đó nó sẽ tự xóa số km cảnh báo ở trên và tính tiếp và theo dõi số liệu mới.
2/ ngoai ra em muốn làm thêm các theo dõi khác ở hàng bên cạnh nhu file mới em gui lên thi làm thế nào anh (theo doi moi se tinh ca km va ngày cái nào den truoc thi no tinh

SA_DQ · 4/7/18

(1) Viết thêm cho bạn sẽ được; Nhưng 2 macro sẽ là "sung đột"
Trong khi macro mới sẽ xóa, thì macro trên sẽ điền dữ liệu lại, 1 khi bạn kích hoạt trang tính này (làm hiện hành nó)

Sẽ fải tìm cách khác để 2 chàng này không sẫy ra xung đột mới được.

tonnydung · 9/7/18

tonnydung đã viết:
Tks bác nhiều. Nhưng gio em có 3 vấn đề gặp nữa.
1/ Giờ em muốn nếu nhập tiếp ngày thay mới của 1 xe nào đó ở dưới thì nó sẽ chỉ hiển thị Km mới của xe đó ở dưới và ở trên nó sẽ không hiển thị nữa thì có được không ?
2/ EM muốn thêm cả các mục thay Lốp, bảo dưỡng bốn bánh (em có bổ xung thêm vào File mới gửi kèm theo) LƯU Ý ở các mục mới sẽ có 2 điều kiện (1 là Km 2 la ngày đến hạn) nó sẽ báo vào cả 2 cột tương ứng (cột ngày nó sẽ đếm còn bao nhiêu ngày nữa sẽ đến so với ngày hiện tại)
3/ Nếu em muốn thêm vài mục khác nữa cần theo dõi nữa thì em phải thêm vòng lặp ở chỗ nào

Hôm trước em coppy code của bác vào và test kỹ thì không ổn. bởi vi.
1/ VD: Cùng 1 biển số xe Bên Sheet KTRA_DENHAN ngày thay dầu ngày 08-7 mà bên Sheet KmHangNgay có các ngày từ 1-6 đến 30-6 chưa có dữ liệu tháng 7 vậy mà bên Sheet KTRA_DENHAN vẫn tính Km từ trước đến giờ mà không căn cứ ngày thay dầu mới đây nhất của Sheet KTRA_DENHAN như vậy sẽ xảy ra sau 1 năm bao nhiêu lần thay dầu rồi nó vẫn cộng KM tất cả vào thì ko thể biết được đã đến kỳ thay dầu mới nhất.

canhbinh0610 · 19/7/18

Như file đính kèm, ở sheet 1 em có RẤT NHIỀU BẢNG (em chỉ liệt kê 3 bảng nhưng thực ra có khoảng 20-30 bảng như vậy) chứa thông tin.
Ở sheet 2 em muốn nó sẽ tổng hợp tất cả thông tin theo từng MARK NO. (Như em đã tổng hợp sẵn nhưng nó tốn rất nhiều thời gian vì phải copy vs paste từng dòng rồi lại phải lọc MARK NO. đó có số lượng hay không) Như sheet 2, em phải lọc tất cả những item mà MARK NO. có số lượng, cụ thể lọc từ A1 đến A4 rồi tiếp tục từ X1 đến X6, C1 đến C3.... Rồi phải xoá những dòng có số lượng bằng 0.
Nhờ các bác giúp đỡ dùm.

Ba Tê · 21/7/18

canhbinh0610 đã viết:
Như file đính kèm, ở sheet 1 em có RẤT NHIỀU BẢNG (em chỉ liệt kê 3 bảng nhưng thực ra có khoảng 20-30 bảng như vậy) chứa thông tin.
Ở sheet 2 em muốn nó sẽ tổng hợp tất cả thông tin theo từng MARK NO. (Như em đã tổng hợp sẵn nhưng nó tốn rất nhiều thời gian vì phải copy vs paste từng dòng rồi lại phải lọc MARK NO. đó có số lượng hay không) Như sheet 2, em phải lọc tất cả những item mà MARK NO. có số lượng, cụ thể lọc từ A1 đến A4 rồi tiếp tục từ X1 đến X6, C1 đến C3.... Rồi phải xoá những dòng có số lượng bằng 0.
Nhờ các bác giúp đỡ dùm.

Làm theo giải thích của bạn nhưng kết quả "trớt huớt" với kết quả mẫu.
Thấy sai nhưng không biết sửa, bạn tự chỉnh lại nhé.

canhbinh0610 · 21/7/18

Ba Tê đã viết:
Làm theo giải thích của bạn nhưng kết quả "trớt huớt" với kết quả mẫu.
Thấy sai nhưng không biết sửa, bạn tự chỉnh lại nhé.

Kết quả của bạn là chính xác. Khác với mình là do mình bị sai sót khi nhập tay.
Chính vì vậy nên code của bạn đã giúp mình vừa nhanh vừa tránh những lỗi sai như vậy.
Thank bạn rất nhiều! Pro quá! 100 Like!

Ba Tê · 21/7/18

canhbinh0610 đã viết:
Thank bạn rất nhiều! Pro quá! 100 Like!

Tiếng Việt gì mà "pha chế" tùm lum vậy.
Bạn là người Việt "gốc ...Tây" sao?

canhbinh0610 · 21/7/18

Ba Tê đã viết:
Tiếng Việt gì mà "pha chế" tùm lum vậy.
Bạn là người Việt "gốc ...Tây" sao?

canhbinh0610 · 21/7/18

Chào bạn Ba Tê!
Mong bạn giúp mình thêm lần nữa.

Như file đính kèm, bạn có thể nào tách cột M ra thành 3 cột khác nhau rồi tự động bỏ những ký tự khác số (O.D, t, MWT) rồi chèn dữ liệu qua sheet 2 như file trước không bạn?

Nếu bạn bận quá ko có thời gian thì có thể ghi chú thích ở sau mỗi dòng trong code trước được không? Mình hơi tối chỗ vòng lặp.

Mình cảm ơn!

Ba Tê đã viết:
Làm theo giải thích của bạn nhưng kết quả "trớt huớt" với kết quả mẫu.
Thấy sai nhưng không biết sửa, bạn tự chỉnh lại nhé.

Chào bạn Ba Tê!
Mong bạn giúp mình thêm lần nữa.

Như file đính kèm, bạn có thể nào tách cột M ra thành 3 cột khác nhau rồi tự động bỏ những ký tự khác số (O.D, t, MWT) rồi chèn dữ liệu qua sheet 2 như file trước không bạn?

Nếu bạn bận quá ko có thời gian thì có thể ghi chú thích ở sau mỗi dòng trong code trước được không? Mình hơi tối chỗ vòng lặp.

Mình cảm ơn!

RoberLiem · 21/7/18

canhbinh0610 đã viết:
Như file đính kèm, bạn có thể nào tách cột M ra thành 3 cột khác nhau rồi tự động bỏ những ký tự khác số (O.D, t, MWT) rồi chèn dữ liệu qua sheet 2 như file trước không bạn?

File này khác file trước, bạn không cho kết quả mẫu nên không biết như thế nào là đúng.
Bạn xem file nhé.

canhbinh0610 · 22/7/18

RoberLiem đã viết:
File này khác file trước, bạn không cho kết quả mẫu nên không biết như thế nào là đúng.
Bạn xem file nhé.

Cảm ơn anh rất nhiều.
Kết quả của anh là chính xác.
Duy còn 1 chút vấn đề nữa thôi ạ.

Trong file em gửi lại cho a. Những cột em bôi đỏ là những cột mình không sử dụng đến (vì nó xuất từ BOM gốc nên em vẫn phải để vậy). Còn 2 cột em bôi cam a có thể đổi giá trị cho nhau ko ạ? Và số lượng (quantity) thì sẽ được tính như sau:
Item "01" thuộc Mark No. "HAH12-BG050" = 6 x 1 (1 set là cố định cho item "HAH12-BG050")
Item "11" thuộc Mark No. "HAH12-BG050" = 2 x 1
............
Item "01" thuộc Mark No. "HAH12-BG055" = 6 x 14..........

Mong anh giúp đỡ!

RoberLiem · 22/7/18

canhbinh0610 đã viết:
Cảm ơn anh rất nhiều.
Kết quả của anh là chính xác.
Duy còn 1 chút vấn đề nữa thôi ạ.

Trong file em gửi lại cho a. Những cột em bôi đỏ là những cột mình không sử dụng đến (vì nó xuất từ BOM gốc nên em vẫn phải để vậy). Còn 2 cột em bôi cam a có thể đổi giá trị cho nhau ko ạ? Và số lượng (quantity) thì sẽ được tính như sau:
Item "01" thuộc Mark No. "HAH12-BG050" = 6 x 1 (1 set là cố định cho item "HAH12-BG050")
Item "11" thuộc Mark No. "HAH12-BG050" = 2 x 1
............
Item "01" thuộc Mark No. "HAH12-BG055" = 6 x 14..........

Mong anh giúp đỡ!

Hiểu chết liền.
Bạn đưa file có kết quả khoảng 10 dòng, ghi chú từng cột bên sheet2 là tính cách nào, từ cột nào của sheet1 để ra kết quả như thế.

canhbinh0610 · 22/7/18

RoberLiem đã viết:
Hiểu chết liền.
Bạn đưa file có kết quả khoảng 10 dòng, ghi chú từng cột bên sheet2 là tính cách nào, từ cột nào của sheet1 để ra kết quả như thế.

Anh vui lòng tham khảo bản mới nhất của em nha!

RoberLiem · 23/7/18

canhbinh0610 đã viết:
Anh vui lòng tham khảo bản mới nhất của em nha!

Bạn thay đổi biểu mẫu liên tục.

canhbinh0610 · 23/7/18

RoberLiem đã viết:
Bạn thay đổi biểu mẫu liên tục.

Cảm ơn anh rất nhiều.

Anh có thể giải nghĩa dùm em mấy dòng code bên dưới không ạ:

sArr = Sheet1.Range("A" & R & "

" & Rws).Value
For N = 9 To 1 Step -1

Em cảm ơn!

chisinhvnn · 26/9/18

Anh chị cho mình hỏi, làm cách nào để redim một mảng với số dòng, số cột bằng kết quả sau khi xử lý không vậy (số dòng, cột có thể tăng, giảm so với mảng gốc)

befaint · 26/9/18

chisinhvnn đã viết:
một mãng... với mãng gốc

.
"Mãng" là gì nhỉ? "Mãng" trong từ "mãng xà" ấy à?

batman1 · 27/9/18

chisinhvnn đã viết:
Anh chị cho mình hỏi, làm cách nào để redim một mảng với số dòng, số cột bằng kết quả sau khi xử lý không vậy (số dòng, cột có thể tăng, giảm so với mảng gốc)

Hãy giải thích đỏ đỏ. Tốt nhất lấy thêm ví dụ để mô tả

Mảng 2 chiều? Đừng bắt người khác đoán khi bạn có thể tự nói.

Mã:

Redim Arr(LBound(result) to UBound(result), LBound(result, 2) to UBound(result, 2))

Nếu mảng kết quả có các chỉ số bắt đầu từ 1 thì gõ ít chút

Mã:

Redim Arr(1 to UBound(result), 1 to UBound(result, 2))

Ý là thế???

befaint · 27/9/18

batman1 đã viết:
Ý là thế???

Em thì đoán như này:
Người ta chắc đang dùng một đoạn code nào đó, kết quả trả về là một mảng KQ (2 chiều, tạm gọi là hàng và cột như người ta mô tả). Tuy nhiên, nó xảy ra trường hợp số lượng kết quả (theo hàng, cột) nằm trong mảng KQ nhỏ hơn số hàng, cột của mảng KQ đã khai báo. Tức là trong mảng KQ đang dư các phần tử không có gì cả.
Và người ta cần làm gì đó (chưa biết ???) nên muốn "Redim" lại mảng KQ kia sao cho số hàng, cột của mảng KQ = số lượng kết quả thực tế trả về (theo hàng, cột), tất nhiên là vẫn giữ được các kết quả đã có trong mảng KQ.

Ví dụ:
Ban đầu có: KQ(1 to 5, 1 to 3)
Sau một đoạn code thì có:
KQ(1,1)=1
KQ(2,1)=2
KQ(3,1)=3
KQ(2,1)=4
KQ(2,2)=5
Kết quả mong muốn: KQ(1 to 3, 1 to 2) và vẫn giữ được các kết quả trong KQ đã có ở bước trên.

batman1 · 27/9/18

befaint đã viết:
Em thì đoán như này:

Thì tôi không hiểu mà. Vì thế mới có "Ý là thế???"

Nếu là "redim mảng kết quả chỉ lấy n dòng và m cột (cùng với các giá trị) đầu, với n và m xác định" thì dễ hiểu hơn nhiều.

Nhưng lại là "redim một mảng với số dòng, số cột bằng kết quả". Chả biết nhà thơ nghĩ gì

Thực ra nếu mảng kết quả sau đó chỉ dùng để đập xuống sheet thì khỏi phải redim. Chỉ cần giới hạn vùng "được đập" trên sheet

Mã:

Sheet1.Range("C10").resize(n, m).value = ketqua

chisinhvnn · 27/9/18

befaint đã viết:
Em thì đoán như này:
Người ta chắc đang dùng một đoạn code nào đó, kết quả trả về là một mảng KQ (2 chiều, tạm gọi là hàng và cột như người ta mô tả). Tuy nhiên, nó xảy ra trường hợp số lượng kết quả (theo hàng, cột) nằm trong mảng KQ nhỏ hơn số hàng, cột của mảng KQ đã khai báo. Tức là trong mảng KQ đang dư các phần tử không có gì cả.
Và người ta cần làm gì đó (chưa biết ???) nên muốn "Redim" lại mảng KQ kia sao cho số hàng, cột của mảng KQ = số lượng kết quả thực tế trả về (theo hàng, cột), tất nhiên là vẫn giữ được các kết quả đã có trong mảng KQ.

Ví dụ:
Ban đầu có: KQ(1 to 5, 1 to 3)
Sau một đoạn code thì có:
KQ(1,1)=1
KQ(2,1)=2
KQ(3,1)=3
KQ(2,1)=4
KQ(2,2)=5
Kết quả mong muốn: KQ(1 to 3, 1 to 2) và vẫn giữ được các kết quả trong KQ đã có ở bước trên.

Dạ đúng như anh nói. Kết quả sau khi xử lý số dòng ở mảng KQ nó sẽ lớn hơn số dòng ở mảng mình tạo ban đầu ban đầu.

Bài đã được tự động gộp: 27/9/18

batman1 đã viết:
Hãy giải thích đỏ đỏ. Tốt nhất lấy thêm ví dụ để mô tả

Mảng 2 chiều? Đừng bắt người khác đoán khi bạn có thể tự nói.

Mã:

Redim Arr(LBound(result) to UBound(result), LBound(result, 2) to UBound(result, 2))

Nếu mảng kết quả có các chỉ số bắt đầu từ 1 thì gõ ít chút

Mã:

Redim Arr(1 to UBound(result), 1 to UBound(result, 2))

Ý là thế???

Em xin trình bày thêm. Mảng ban đầu của em là có 5 dòng, 3 cột. Sau khi xử lý số liệu kết quả trả về số dòng có thể lớn hơn hoặc nhỏ hơn số dòng ở mảng ban đầu (không xác định được). Vậy cho em hỏi làm thế nào để redim mảng bằng số số dòng, số cột ở kết quả xử lý không? Vi dụ Mảng ban đầu BD(5 dòng, 3 cột). , kết quả KQ(7dòng, 3 cột). Mình Redim KQ như thến nào để xác định được (7 dòng, 3 cột)

befaint · 27/9/18

chisinhvnn đã viết:
Sau khi xử lý số liệu kết quả trả về số dòng có thể lớn hơn... Vi dụ Mảng ban đầu BD(5 dòng, 3 cột), kết quả KQ(7dòng, 3 cột)

Kết quả cuối cùng không có chuyện lớn hơn đâu. Nếu có lớn hơn thì trong code đã xử lý để mảng KQ có kích thước đủ lớn chứa hết các kết quả rồi.

chisinhvnn đã viết:
Dạ đúng như anh nói. Kết quả sau khi xử lý số dòng ở mảng KQ nó sẽ lớn hơn số dòng ở mảng mình tạo ban đầu ban đầu.

Hồi chưa biết gì mình dùng code có sẵn cũng bị dính y chang, rồi phải viết thêm hàm để lấy các phần tử trong mảng kết quả... Thấy hơi buồn cười nhưng tạm dùng đã.
Bạn gửi cái code đang dùng đó lên đây, sẽ có cách xử lý cho kết quả hợp lý nhất.

chisinhvnn · 27/9/18

befaint đã viết:
Kết quả cuối cùng không có chuyện lớn hơn đâu. Nếu có lớn hơn thì trong code đã xử lý để mảng KQ có kích thước đủ lớn chứa hết các kết quả rồi.

Hồi chưa biết gì mình dùng code có sẵn cũng bị dính y chang, rồi phải viết thêm hàm để lấy các phần tử trong mảng kết quả... Thấy hơi buồn cười nhưng tạm dùng đã.
Bạn gửi cái code đang dùng đó lên đây, sẽ có cách xử lý cho kết quả hợp lý nhất.

Nhờ anh xem giúp
ReDim dArr(1 To UBound(sArr) * 2, 1 To 13) . Để xử lý do dòng nhiều hơn nên x 2
Với code trong file ghi xuống sheet thì không có gì. Em muốn hỏi thêm xem có cách xử lý nào khác để vận dụng trong file của mình

befaint · 27/9/18

chisinhvnn đã viết:
Nhờ anh xem giúp
ReDim dArr(1 To UBound(sArr) * 2, 1 To 13) . Để xử lý do dòng nhiều hơn nên x 2
Với code trong file ghi xuống sheet thì không có gì. Em muốn hỏi thêm xem có cách xử lý nào khác để vận dụng trong file của mình

Mình thấy bắt đầu vòng vo rồi à. Nếu không nêu được trường hợp nào cần thiết như câu hỏi ban đầu thì dừng.
----
(Kiểu chung chung thì như vầy) Với mảng KQ( 1 To x, 1 to N), N là cố định thì có thể:
- Xoay 90 độ mảng KQ: KQ( 1 To N, 1 to x), sau khi xử lý được k cột kết quả thì dùng Redim Preserve KQ(1 To N, 1 to k) và viết một hàm TransposeArr() để xoay cái mảng KQ thành KQ(1 to k, 1 to N).
- Thêm biến để ghi nhớ số dòng, số cột kết quả. Muốn làm gì thì cứ lấy 2 biến đó mà dùng.
Ví dụ bạn viết một hàm trả về KQ( 1 To x, 1 to y) nhưng giờ viết sao kết quả trả về Res(1 to 3), với:
Res(1)=KQ( 1 To x, 1 to y)
Res(2)=N 'với N=1:x
Res(3)=M 'với M=1:y
(N, M là số dòng, cột kết quả thực tế).

chisinhvnn · 27/9/18

befaint đã viết:
Mình thấy bắt đầu vòng vo rồi à. Nếu không nêu được trường hợp nào cần thiết như câu hỏi ban đầu thì dừng.
----
(Kiểu chung chung thì như vầy) Với mảng KQ( 1 To x, 1 to N), N là cố định thì có thể:
- Xoay 90 độ mảng KQ: KQ( 1 To N, 1 to x), sau khi xử lý được k cột kết quả thì dùng Redim Preserve KQ(1 To N, 1 to k) và viết một hàm TransposeArr() để xoay cái mảng KQ thành KQ(1 to k, 1 to N).
- Thêm biến để ghi nhớ số dòng, số cột kết quả. Muốn làm gì thì cứ lấy 2 biến đó mà dùng.
Ví dụ bạn viết một hàm trả về KQ( 1 To x, 1 to y) nhưng giờ viết sao kết quả trả về Res(1 to 3), với:
Res(1)=KQ( 1 To x, 1 to y)
Res(2)=N 'với N=1:x
Res(3)=M 'với M=1:y
(N, M là số dòng, cột kết quả thực tế).

Cảm ơn anh. Em tạo thêm 1 mảng rồi Redim lại theo biến k là lấy được số hàng.

batman1 · 27/9/18

Càng đọc càng không hiểu

chisinhvnn đã viết:
Vi dụ Mảng ban đầu BD(5 dòng, 3 cột). , kết quả KQ(7dòng, 3 cột). Mình Redim KQ như thến nào để xác định được (7 dòng, 3 cột)

Nếu KQ đã có 7 dòng 3 cột rồi thì sao lại phải redim KQ để có 7 dòng 3 cột?

chisinhvnn · 27/9/18

batman1 đã viết:
Càng đọc càng không hiểu

Nếu KQ đã có 7 dòng 3 cột rồi thì sao lại phải redim KQ để có 7 dòng 3 cột?

tại em trình bày kém quá. 7 dòng là sau khi xử lý số liệu mới biết. như vidu bài 1001 của em. Dòng dữ chỉ có 17 dòng (dữ liệu), nhưng sau khi xử lý số dòng nó lên 20 dòng (sheet2)

aduy89 · 28/9/18

ndu96081631 đã viết:
Ví dụ thế này:
- Bạn có dữ liệu tại A1:A10
- Bạn muốn nối chuổi từ các cell ở vùng trên
- Bạn nghĩ ra có thể dùng làm Join để làm điều này
- Nhưng hàm Join chỉ làm việc với mảng 1 chiều
- Vậy việc của bạn phải biến Range("A1:A10") thành 1 mảng và phải là mảng 1 chiều
Ta làm như sau:

PHP:

Sub Test() Dim Arr Arr = Range("A1:A10").Value Arr = WorksheetFunction.Transpose(Arr) Range("B1") = Join(Arr, ", ") End Sub

Rút gọn:

PHP:

Sub Test() Dim Arr Arr = WorksheetFunction.Transpose(Range("A1:A10")) Range("B1") = Join(Arr, ", ") End Sub

Rút gọn tiếp:

PHP:

Sub Test() Range("B1") = Join(WorksheetFunction.Transpose(Range("A1:A10")), ", ") End Sub

Tóm lại:
- Với 1 Range là 1 vùng có nhiều dòng, 1 cột thì khi qua hàm TRANSPOSE nó sẽ biến thành mảng 1 chiều
- Với 1 Range là 1 vùng có nhiều cột, 1 dòng thì khi qua hàm TRANSPOSE nó sẽ biến thành mảng 2 chiều (có thể mường tượng là mảng dọc) ---> Lại qua hàm TRANSPOSE tiếp lần nữa, nó sẽ biến thành mảng 1 chiều
Ví dụ: Nối chuổi các cell trong vùng A1:J1

PHP:

Sub Test() With WorksheetFunction Range("A2") = Join(.Transpose(.Transpose(Range("A1:J1"))), ", ") End With End Sub

Phải 2 lần TRANSPOSE mới có thể biến Range("A1:J1") thành mảng 1 chiều
-------------
Nói thêm:
- Đã gọi là mảng 1 chiều thì không mường tượng nó là DỌC NGANG gì cả... đơn giàn là MẢNG 1 CHIỀU thôi
- Mảng 1 chiều và 2 chiều có thể mường tượng chúng khác nhau như khi so sánh ĐƯỜNG THẰNG và MẶT PHẲNG vậy (đường thẳng chỉ có duy nhất chiều dài, còn mặt phẳng thì mới có 2 chiều DỌC, NGANG)

Thưa thầy e không hiểu. Như thầy nói 1 range chuyển về mảng nó là mảng 2 chiều. Vậy range("A1:J1") chuyen ve mảng nó là mảng 2 chiều. Dung transpose 1 lần nó ra 1 chiều . Sao lại là 2 lần tranpose... Dạ e mới học nên chưa hiểu sâu mong thầy giảng ạ

ndu96081631 · 28/9/18

aduy89 đã viết:
Thưa thầy e không hiểu. Như thầy nói 1 range chuyển về mảng nó là mảng 2 chiều. Vậy range("A1:J1") chuyen ve mảng nó là mảng 2 chiều. Dung transpose 1 lần nó ra 1 chiều . Sao lại là 2 lần tranpose... Dạ e mới học nên chưa hiểu sâu mong thầy giảng ạ

Thì tại nó... vậy đấy mà. Đọc chỗ "TÓM LẠI" và thuộc lòng là được

thaytutn · 8/10/18

Các thầy và các anh ơi! Em mới tìm hiểu về mảng nên gà mờ quá! Các thầy và các anh giúp em gỡ rối chỗ này được không ạ. Em có 1 sheet CSDL, Giờ em dùng 1 mảng động để lọc ra những kết quả em cần lấy, Ví dụ như màng KQ() của em đã có dữ liệu, giờ làm cách nào để tạo ra 1 file excel mới vớ 1 sheet và đổ được kết quả từ mảng KQ() này vào sheét mới ở workbook mới kia ạ? Các thầy giúp em với ạ

nguyenthuy13388 · 19/10/18

Chào mọi người

Tôi có 01 gặp phải 1 vấn đề với 1 đoạn code như dưới đây rất mong nhận được giúp đỡ ạ:

Mã:

Sub hien_thi()
Dim Arr, Shp, a As Long, i As Long

With Sheet1
    .DrawingObjects.Visible = True
    Arr = Array("TB_lx_1", "TB_lx_2", "TB_lx_3", "TB_lx_4", "TB_lx_5", "TB_lx_7")
    a = .Shapes("TB_lx_1").Top
    For Each Shp In Arr
        For i = 1 To 7
            If .Cells(i, "B") = "" Then
                .Shapes("TB_lx_" & i).Visible = False
            End If
        Next i
        If .Shapes(Shp).Visible = False Then
            .Shapes("gia tri tiep theo cua Shp").Top = a ' giá trị tiếp theo ngay sau .Shapes(Shp) bị ẩn
        Else
            .Shapes("gia tri tiep theo cua Shp").Top = a + .Shapes(Shp).Height
        End If
    Next Shp
End With
End Sub

cái gia tri tiep theo cua Shp đó tôi phải viết sao mới đúng ạ???

ndu96081631 · 19/10/18

nguyenthuy13388 đã viết:
Chào mọi người

Tôi có 01 gặp phải 1 vấn đề với 1 đoạn code như dưới đây rất mong nhận được giúp đỡ ạ:

Mã:

Sub hien_thi() Dim Arr, Shp, a As Long, i As Long With Sheet1 .DrawingObjects.Visible = True Arr = Array("TB_lx_1", "TB_lx_2", "TB_lx_3", "TB_lx_4", "TB_lx_5", "TB_lx_7") a = .Shapes("TB_lx_1").Top For Each Shp In Arr For i = 1 To 7 If .Cells(i, "B") = "" Then .Shapes("TB_lx_" & i).Visible = False End If Next i If .Shapes(Shp).Visible = False Then .Shapes("gia tri tiep theo cua Shp").Top = a ' giá trị tiếp theo ngay sau .Shapes(Shp) bị ẩn Else .Shapes("gia tri tiep theo cua Shp").Top = a + .Shapes(Shp).Height End If Next Shp End With End Sub

cái gia tri tiep theo cua Shp đó tôi phải viết sao mới đúng ạ???

Cuối cùng là bạn muốn làm cái gì?

nguyenthuy13388 · 19/10/18

ndu96081631 đã viết:
Cuối cùng là bạn muốn làm cái gì?

Dạ. em muốn làm cái thông báo dạng hình ảnh phía dưới ạ.
giả sử em có 7 shapes cho 7 cái thông báo, tuy nhiên chỉ có 5 cái thông báo có dữ liệu, còn lại 2 cái không có thì sẽ ẩn đi.
nhưng khi ẩn cái thứ 3 và thứ 5 thì nó sẽ bị trống giữa nên em viết đoạn code kia để cho toàn bộ các shapes về sau sếp lần lượt ngay dưới vị trí của shapes đầu tiên có dữ liệu ạ.

ndu96081631 · 19/10/18

nguyenthuy13388 đã viết:
Dạ. em muốn làm cái thông báo dạng hình ảnh phía dưới ạ.
giả sử em có 7 shapes cho 7 cái thông báo, tuy nhiên chỉ có 5 cái thông báo có dữ liệu, còn lại 2 cái không có thì sẽ ẩn đi.
nhưng khi ẩn cái thứ 3 và thứ 5 thì nó sẽ bị trống giữa nên em viết đoạn code kia để cho toàn bộ các shapes về sau sếp lần lượt ngay dưới vị trí của shapes đầu tiên có dữ liệu ạ.

Vẫn chưa hiểu lắm.
Có điều thắc mắc rằng: Câu hỏi của bạn thì liên quan gì đến chủ đề "MẢNG TRONG VBA (ARRAY)"
???

nguyenthuy13388 · 19/10/18

Trước hết em cảm ơn anh đã quan tâm,

ndu96081631 đã viết:
Vẫn chưa hiểu lắm.
Có điều thắc mắc rằng: Câu hỏi của bạn thì liên quan gì đến chủ đề "MẢNG TRONG VBA (ARRAY)"
???

Vì học hành không đến nơi đến chốn thôi bác ạ,
Tuy nhiên em cũng đã giải quyết được vấn đề. bằng cách thay vì em thay đổi cái vị trí xuất hiện của từng shapes thì em thay đổi phần "text" viết trên từng shapes đó anh ạ
em shared file lên đây nếu ai có ý tưởng làm cái thông báo như vậy tham khảo ạ,

FPT_online · 20/10/18

Cho em hỏi muốn đưa các Cells rời rạc vào mảng thì làm như nào, VD em chọn ô A5, A7, A3 xong Chạy Macro thì 3 ô này sẽ đc ghi vào mảng. Mọi người giúp em với

CHAOQUAY · 20/10/18

FPT_online đã viết:
Cho em hỏi muốn đưa các Cells rời rạc vào mảng thì làm như nào, VD em chọn ô A5, A7, A3 xong Chạy Macro thì 3 ô này sẽ đc ghi vào mảng. Mọi người giúp em với

Hiểu không chắc lắm nhưng bạn thử code này xem sao

Mã:

Sub GhiMang()
Dim Arr As Variant
Dim i, j, k
k = Selection.Count
ReDim Arr(1 To k)
For Each i In Selection
    j = j + 1
    Arr(j) = i
Next i
Range("C1").Resize(1, UBound(Arr)) = Arr
End Sub

FPT_online · 20/10/18

CHAOQUAY đã viết:
Hiểu không chắc lắm nhưng bạn thử code này xem sao

Mã:

Sub GhiMang() Dim Arr As Variant Dim i, j, k k = Selection.Count ReDim Arr(1 To k) For Each i In Selection j = j + 1 Arr(j) = i Next i Range("C1").Resize(1, UBound(Arr)) = Arr End Sub

Đúng ý rồi anh ạ

forpromise2013 · 20/10/18

Các anh chị cho em hỏi chút.
Giờ em muốn gán giá trị của 1 vùng bao gồm A1:A5, C1:C5, G1:G5 vào một mảng. Rồi từ mảng đó em lại gán giá trị vào 1 vùng khác B11:B15, D11

15, E11:E15.
Có cách nào để thực hiện việc gán giá trị như vậy ko ạ?

namkpac · 24/10/18

ptm0412 đã viết:
1. Mảng ngang với các giá trị từ A1 đến A10: Được, gán từng giá trị một.:

Nhưng vẫn là ngang nhé, nên nếu gán ngược xuống sheet thì phải coi chừng quên.

PHP:

Sub Test3 () Dim Arr(1 to 10) For i = 1 to 10 Arr(i) = Cells(i, 1) Next Range("B1:B10") = Arr Range("C5:L5") = Arr End Sub

Ta sẽ thấy B1:B10 cả 10 ô có cùng giá trị của A1. trong khi đó C5:L5 hiện đầy đủ theo hàng ngang.

Em xin hỏi thầy và các anh chị, với sub text3 này thì từ B1:B10 đã điền arr vào nhưng C5:L5 thì chỉ có C5 được điền giá trị thì là vì sao? và em thay từ C5:C10 thì điền dữ liệu arr vào bình thường như vậy chỉ có thể điền cột chứ dòng không điền được.

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

Người dùng đang xem chủ đề này

Thành viên gắn bó

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

Cute Black Cat

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

Thành viên tích cực

Cute Black Cat

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

Thành viên tích cực

File đính kèm

Huyền thoại GPE

Thành viên tích cực

Huyền thoại GPE

Thành viên gắn bó

Thành viên tích cực

File đính kèm

Thành viên tích cực

Thành viên tích cực

BĂNG TRÔI

BĂNG TRÔI

Thành viên tích cực

Thành viên chính thức

File đính kèm

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

Thành viên chính thức

Thành viên chính thức

Thành viên mới

Thành viên chính thức

Thành viên tích cực

Cute Black Cat

Thành viên mới

File đính kèm

Thành viên chính thức

Huyền thoại GPE

Thành viên chính thức

Huyền thoại GPE

File đính kèm

Thành viên chính thức

File đính kèm

Thành viên tích cực

Thành viên chính thức

Thành viên chính thức

Thành viên chính thức

File đính kèm

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

File đính kèm

Chuyên gia GPE

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

Huyền thoại GPE

Thành viên tích cực

Thành viên tích cực

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

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

Chuyên gia GPE

Huyền thoại GPE

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

Thành viên tích cực

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

Thành viên tích cực

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

Thành viên tích cực

Huyền thoại GPE

Thành viên tích cực

Thành viên chính thức

BBB

Thành viên chính thức

File đính kèm

Thành viên chính thức

File đính kèm

/(hông là gì!

Thành viên chính thức

File đính kèm

/(hông là gì!

Thành viên chính thức

/(hông là gì!

Thành viên chính thức

Thành viên mới

File đính kèm

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