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

Được ạ, nhưng bước này có thể xử lý trong mảng mà không ảnh hưởng(thay đổi) gì dữ liệu gốc trên sheet được không ạ?

Nhấp chuột vào đây để mở rộng...

alias1313 đã viết:

Mong các anh giúp em trường hợp về mảng! Như file đính kèm.
- Quét Date ở ô L5 với mảng Ngay = Range("G4:I4").value nếu có ngày trùng thì
Quét tiếp Type ở Range("N5") với mảng CHUAN =Range("G5:J7").value nếu Type trùng thì
add Name ở Range("M5").value vào mang GT = Range("G8:I10").value với row/col vừa tìm được: GT(j,i) = Range("M5").value

Mã:Sao chép.

Sub Test()
Dim Ngay As Variant, GT As Variant, CHUAN As Variant
Ngay = Range("G4:I4").Value
CHUAN = Range("G5:I7").Value
GT = Range("G8:I10").Value
        For i = 1 To 3
            For j = 1 To 3
                 If Ngay(1, i) = Range("L5").Value Then
                     If CHUAN(j, i) = Range("N5").Value Then     'Type: E
                         GT(j, i) = Range("M5").Value                'Name: Nguyen A

                     End If
                 End If
            Next j
        Next i
MsgBox ("Done")
End Sub

1.> Khi em chạy xong Name: Nguye A không được add vào cell GT(j,i), em đang tìm hiểu về mảng đọc trong topic này nhưng chưa tìm ra nguyên nhân
2.> Với GT(j,i) em muốn xác định địa chỉ ô excel của nó thì làm thế nào ạ! Row/cell = ? ( kiểu như
3.> Để thực hiện yêu cầu trên còn cách nào tối ưu hơn không ạ!
Em cảm ơn các anh nhiều!

Nhấp chuột vào đây để mở rộng...

snow25 đã viết:

Bạn viết code rồi.Vậy bạn muốn thế nào.Mà có file nào đâu nhỉ.

Nhấp chuột vào đây để mở rộng...

alias1313 đã viết:

Em mới up file lên rồi ạ!
Em muốn add Name: Nguyen A vào mảng GT với dữ liệu xác định là: ngày và Type : E!
Mong anh @snow25 giúp đỡ!

Nhấp chuột vào đây để mở rộng...

Range("G8:I10").Value = GT

snow25 đã viết:

Bạn điền nó vào mảng rồi thì phải gắn nó lại excel chứ.Thêm câu lệnh này vào.

Mã:Sao chép.

Range("G8:I10").Value = GT

Nhấp chuột vào đây để mở rộng...

alias1313 đã viết:

Hà hà! Thì ra vậy! em làm được rồi! Cảm ơn anh nhiều!
2.> Với GT(j,i) em muốn xác định địa chỉ ô excel của nó thì làm thế nào ạ! Row/cell = ? ( kiểu như cells(m,n))
Mình có thể xác định vị trí cells ko anh!

Nhấp chuột vào đây để mở rộng...

snow25 đã viết:

Vậy tùy bạn thôi bạn xem vị trí nó ở đâu rồi cộng thêm vào cho giống địa chỉ ở excel là được mà.

Nhấp chuột vào đây để mở rộng...

Sub test

dim Arr2

Arr2 = Array("GT", "BT", "QT", "KT")

      For k = 1 to 4

          If Arr2(k) = Range("A1").Value Then

                Arr2(j, i) = Range("M5").Value  

          end if

      next for

End sub

alias1313 đã viết:

Anh cho em hỏi thêm!
Em có 3 Array: GT , BT, QT
em muốn dùng một tên đại diện cho 3 array đó = Arr1 để em gọi khi cần kiểu như:
If Range("A1").value = "BT" then ( thì gán tên BT cho Arr1 )
Arr1(j,i) = Range("M5").Value ( thay cho: BT(j, i) = Range("M5").Value )
hay mình có thể:
Range("A1").Value & "(j,i) = Range("M5").Value ( thay cho: BT(j, i) = Range("M5").Value )

Không biết mình có cách nào làm vậy không anh!
em cũng có thử kiểu dưới nhưng không được!

Mã:Sao chép.

Sub test

dim Arr2

Arr2 = Array("GT", "BT", "QT", "KT")

      For k = 1 to 4

          If Arr2(k) = Range("A1").Value Then

                Arr2(j, i) = Range("M5").Value 

          end if

      next for

End sub

Mong anh giúp đỡ!

Nhấp chuột vào đây để mở rộng...

snow25 đã viết:

Mục đích bạn làm vậy để làm gì nhỉ.

Nhấp chuột vào đây để mở rộng...

alias1313 đã viết:

Cái này để em thêm tên nhân viên vào bảng công tương ứng.
Em Quét ngày, nếu có ngày thì quét Group xác định Goup
Quét Type ở mảng CHUAN để đưa ra vị trí tương ứng sau khi có vị trí nhờ Type thi
Điền tên Nguyen A vào Goup tương ứng với vị trí Type tương ứng vừa xác định .
Em có add file đính kèm anh xem giúp em!

Nhấp chuột vào đây để mở rộng...

alias1313 đã viết:

Cái này để em thêm tên nhân viên vào bảng công tương ứng.
Em Quét ngày, nếu có ngày thì quét Group xác định Goup
Quét Type ở mảng CHUAN để đưa ra vị trí tương ứng sau khi có vị trí nhờ Type thi
Điền tên Nguyen A vào Goup tương ứng với vị trí Type tương ứng vừa xác định .
Em có add file đính kèm anh xem giúp em!

Nhấp chuột vào đây để mở rộng...

Public Sub sGpe()
Const Col As Long = 3
Const Rws As Long = 3
Dim Gr1(), Gr2(), Arr(), Dat()
Dim I As Long, J As Long, Ngay As Date, Typ As String, Grp As String, Txt As String
        Dat = Range("G4").Resize(, Col).Value
        Arr = Range("G5").Resize(Rws, Col).Value
        Gr1 = Range("G8").Resize(Rws, Col).Value
        Gr2 = Range("G12").Resize(Rws, Col).Value
    Ngay = Range("L5").Value
    Txt = Range("M5").Value
    Typ = Range("N5").Value
    Grp = Right(Range("O5"), 1)
For J = 1 To Col
    If Dat(1, J) = Ngay Then
        For I = 1 To Rws
            If Arr(I, J) = Typ Then
                If Grp = "1" Then
                    Gr1(I, J) = Txt
                    Range("G8").Resize(Rws, Col) = Gr1
                Else
                    Gr2(I, J) = Txt
                    Range("G12").Resize(Rws, Col) = Gr2
                End If
                Exit For
            End If
        Next I
        Exit For
    End If
Next J
End Sub

alias1313 đã viết:

Cái này để em thêm tên nhân viên vào bảng công tương ứng.
Em Quét ngày, nếu có ngày thì quét Group xác định Goup
Quét Type ở mảng CHUAN để đưa ra vị trí tương ứng sau khi có vị trí nhờ Type thi
Điền tên Nguyen A vào Goup tương ứng với vị trí Type tương ứng vừa xác định .
Em có add file đính kèm anh xem giúp em!

Nhấp chuột vào đây để mở rộng...

alias1313 đã viết:

....
em cũng có thử kiểu dưới nhưng không được!

Mã:Sao chép.

Sub test

dim Arr2

Arr2 = Array("GT", "BT", "QT", "KT")

      For k = 1 to 4

          If Arr2(k) = Range("A1").Value Then

                Arr2(j, i) = Range("M5").Value

          end if

      next for

End sub

Nhấp chuột vào đây để mở rộng...

Ba Tê đã viết:

Dữ liệu chẳng logic gì cả.
Nếu chỉ có 2 nhóm thì tạo thành "4 vùng chiến thuật" để xử lý.
Nếu tùm lum nhóm thì phải đưa dữ liệu giống thật mới xử được.

PHP:Sao chép.

Public Sub sGpe()
Const Col As Long = 3
Const Rws As Long = 3
Dim Gr1(), Gr2(), Arr(), Dat()
Dim I As Long, J As Long, Ngay As Date, Typ As String, Grp As String, Txt As String
        Dat = Range("G4").Resize(, Col).Value
        Arr = Range("G5").Resize(Rws, Col).Value
        Gr1 = Range("G8").Resize(Rws, Col).Value
        Gr2 = Range("G12").Resize(Rws, Col).Value
    Ngay = Range("L5").Value
    Txt = Range("M5").Value
    Typ = Range("N5").Value
    Grp = Right(Range("O5"), 1)
For J = 1 To Col
    If Dat(1, J) = Ngay Then
        For I = 1 To Rws
            If Arr(I, J) = Typ Then
                If Grp = "1" Then
                    Gr1(I, J) = Txt
                    Range("G8").Resize(Rws, Col) = Gr1
                Else
                    Gr2(I, J) = Txt
                    Range("G12").Resize(Rws, Col) = Gr2
                End If
                Exit For
            End If
        Next I
        Exit For
    End If
Next J
End Sub

Nhấp chuột vào đây để mở rộng...

snow25 đã viết:

Bạn đưa dữ liệu chuẩn lên đây mình thử code xem được không nhé.

Nhấp chuột vào đây để mở rộng...

alias1313 đã viết:

Em thành thật xin lỗi! Vì việc đưa dữ liệu không chuẩn đã gây ra những phiền toái và mất thời gian của các anh!
Em xin ghi nhớ điều này! Cũng mong các anh thông cảm vì một người kiến thức lập trình còn yếu không lường hết được sự việc.
Em xin up lại dữ liệu chuẩn theo công việc mong các anh giúp em!
Mới đầu em chỉ nghĩ hỏi từng phần để vừa làm vừa hỏi cho hiểu về mảng.
Nội dung công việc của em:

-Em tạo một bảng dữ liệu đi ca.
-Gồm 6 nhóm, mỗi nhóm phụ trách 1 công việc khác nhau. Đi theo lịch đi ca như bảng CHUAN.
-Khi nhân viên muốn đổi ca em muốn cập nhật tên nhân viên vào bảng đi ca tương ứng dựa vào : Ngày đổi, ca đi, nhóm, tên.
Em có add file đính kèm!
Mong các anh giúp em!

Bài đã được tự động gộp: 16/2/19

Cảm ơn anh đã giúp em ! em đã test code chạy đúng theo yêu cầu của em!
Anh có thể giúp em thêm file bên dưới được không anh!

Bài đã được tự động gộp: 16/2/19

Mong anh @snow25 giúp đỡ!

Nhấp chuột vào đây để mở rộng...

Sub doiulieu()
Dim arr, arr1, dic As Object, i As Long, lr As Long, j As Long, dk As String, dks As String, b As Long, c As Long, d As Long
Set dic = CreateObject("scripting.dictionary")
With Sheet1
     arr = .Range("D5:n9").Value
     For j = 1 To UBound(arr, 2)
         For i = 3 To UBound(arr, 1)
             dk = CLng(arr(1, j)) & "#" & arr(i, j)
             If Not dic.exists(dk) Then
                dic.Item(dk) = Array(i - 4, j)
             End If
         Next i
     Next j
     lr = .Range("D" & Rows.Count).End(xlUp).Row
     If lr < 11 Then Exit Sub
     arr = .Range("a11:N" & lr).Value
     For i = 1 To UBound(arr, 1)
         If Len(arr(i, 1)) > 0 Then
            If Not dic.exists(arr(i, 1)) Then
               dic.Add arr(i, 1), i
            End If
         End If
     Next i
     dk = CLng(.Range("T14").Value) & "#" & .Range("V14").Value
     dks = .Range("W14").Value
     If dic.exists(dk) Then
           b = dic.Item(dk)(0)
           c = dic.Item(dk)(1)
         If dic.exists(dks) Then
            d = dic.Item(dks)
            arr(b + d, c + 3) = .Range("u14").value
           End If
      End If
      .Range("a11:N" & lr).Value = arr
End With
End Sub

snow25 đã viết:

Đây bạn xem.Có đúng không nhé.

Mã:Sao chép.

Sub doiulieu()
Dim arr, arr1, dic As Object, i As Long, lr As Long, j As Long, dk As String, dks As String, b As Long, c As Long, d As Long
Set dic = CreateObject("scripting.dictionary")
With Sheet1
     arr = .Range("D5:n9").Value
     For j = 1 To UBound(arr, 2)
         For i = 3 To UBound(arr, 1)
             dk = CLng(arr(1, j)) & "#" & arr(i, j)
             If Not dic.exists(dk) Then
                dic.Item(dk) = Array(i - 4, j)
             End If
         Next i
     Next j
     lr = .Range("D" & Rows.Count).End(xlUp).Row
     If lr < 11 Then Exit Sub
     arr = .Range("a11:N" & lr).Value
     For i = 1 To UBound(arr, 1)
         If Len(arr(i, 1)) > 0 Then
            If Not dic.exists(arr(i, 1)) Then
               dic.Add arr(i, 1), i
            End If
         End If
     Next i
     dk = CLng(.Range("T14").Value) & "#" & .Range("V14").Value
     dks = .Range("W14").Value
     If dic.exists(dk) Then
           b = dic.Item(dk)(0)
           c = dic.Item(dk)(1)
         If dic.exists(dks) Then
            d = dic.Item(dks)
            arr(b + d, c + 3) = .Range("u14").value
           End If
      End If
      .Range("a11:N" & lr).Value = arr
End With
End Sub

Nhấp chuột vào đây để mở rộng...

VetMini đã viết:

"không được" tức là sao?
ít nhất cũng phải cho người ta biết chi tiết của cái "không được" ấy.
Đoạn code trên chưa cần biết đúng hay sai. Trước mắt là trật thuật ngữ.
Arr2 = Array("GT", "BT", "QT", "KT") ' Arr2 được gán cho cái mảng 1 chiều
...
Arr2(j, i) = Range("M5").Value ' i là chỉ số chiều thứ hai - chiều này ở đâu ra?

Nhấp chuột vào đây để mở rộng...

snow25 đã viết:

Đây bạn xem.Có đúng không nhé.

Mã:Sao chép.

Sub doiulieu()
Dim arr, arr1, dic As Object, i As Long, lr As Long, j As Long, dk As String, dks As String, b As Long, c As Long, d As Long
Set dic = CreateObject("scripting.dictionary")
With Sheet1
     arr = .Range("D5:n9").Value
     For j = 1 To UBound(arr, 2)
         For i = 3 To UBound(arr, 1)
             dk = CLng(arr(1, j)) & "#" & arr(i, j)
             If Not dic.exists(dk) Then
                dic.Item(dk) = Array(i - 4, j)
             End If
         Next i
     Next j
     lr = .Range("D" & Rows.Count).End(xlUp).Row
     If lr < 11 Then Exit Sub
     arr = .Range("a11:N" & lr).Value
     For i = 1 To UBound(arr, 1)
         If Len(arr(i, 1)) > 0 Then
            If Not dic.exists(arr(i, 1)) Then
               dic.Add arr(i, 1), i
            End If
         End If
     Next i
     dk = CLng(.Range("T14").Value) & "#" & .Range("V14").Value
     dks = .Range("W14").Value
     If dic.exists(dk) Then
           b = dic.Item(dk)(0)
           c = dic.Item(dk)(1)
         If dic.exists(dks) Then
            d = dic.Item(dks)
            arr(b + d, c + 3) = .Range("u14").value
           End If
      End If
      .Range("a11:N" & lr).Value = arr
End With
End Sub

Nhấp chuột vào đây để mở rộng...

HieuCD đã viết:

Dic thường dùng lưu dữ liệu và truy xuất nhiều lần, bài nầy chỉ tìm 1 lần, dùng Dic khá lãng phí, thử bỏ Dic code sẽ gọn và nhanh hơn
Trong code nên thêm phần thông báo không đổi được do trong ngày, nhóm đó không có ca tương ứng

Nhấp chuột vào đây để mở rộng...

Sub CA()

Dim Ngay As Variant, GT As Variant, CHUAN As Variant
Dim ARR3 As Variant
Dim i
Dim j
Dim k
Dim range1 As Range
Dim Arr8 As Variant
Ngay = Range("D5:N5").Value
CHUAN = Range("D7:N9").Value
GT = Range("D11:N13").Value
BT = Range("D15:N17").Value
MGT = Range("D19:N21").Value
MBT = Range("D23:N25").Value
QT = Range("D27:N29").Value
KT = Range("D31:N33").Value
arr = Range("W14").Value
For i = 1 To 11
    For j = 1 To 3
        For k = 1 To 4
            If Ngay(1, i) = Range("T14").Value Then
             
                For Each range1 In Range("A8:A32")
                        If range1.Value = Range("W14").Value Then                            ' xac dinh Group
                            row1 = range1.Row
                            col1 = range1.Column
                            Arr8 = Range(Cells(row1 - 1, 4), Cells(row1 + 1, 14)).Value  ' Xac dinh mang Group
                                If CHUAN(j, i) = Range("V14").Value Then                         'xác dinh Ca
                                    Arr8(j, i) = Range("U14").Value                                      ' add Name
                                    Range(Cells(row1 - 1, 4), Cells(row1 + 1, 14)).Value = Arr8

                                End If
                        End If
                Next range1
            End If


        Next k
    Next j

Next i
MsgBox ("Done")
End Sub