VBA cộng mảng liên tục và gián đoạn

Liên hệ QC
hongphuong1997 đã viết:
Hu hu... hu.... bác ơi, bác chú thích rõ như thế, nhưng cháu không hiểu thuật toán như nào? Thế mà bác viết được như vậy? Bác có thể chỉ dẫn cho cháu nguyên lý như nào được không hả bác?
Nhấp chuột vào đây để mở rộng...
Đây là code dạng khó có tới 4 vòng For lồng nhau, những người mới bắt đầu làm quen với code khó có thể phân tích và viết được code
Mình quan sát dữ liệu và kết quả truy xuất, tìm mối liên hệ có tính qui luật, thử các con số và các phương án ... từ đó mới đưa ra thuật toán, chạy thử không được thì chỉnh lại từ từ, sai nhiều lần mới được 1 kết quả đúng
Bạn nên bắt đầu với code 1 vài vòng For cho quen rồi mới tới nhiều vòng For, phải có thời gian mới ngộ được
Sở trường của mình là thêm bớt, cộng trừ nhân chia các con số để ra con số phù hợp:)
 
HieuCD đã viết:
Mã: 
Sub GPE4() 'tong quat
  Dim sArr() 'Mang du lieu
  Dim Res() 'Mang ket qua
  Dim i As Long, j As Long, sR As Long, mk As Byte, nk As Byte
  Const n = 2 'so dòng cong
  Const m = 3 'so mang ket qua
  Const d = 2 'Só dòng trong giua 2 ket qua
  Const sRngStr = "C2:AA13" 'Dia chi vùng du lieu
  Const rRngStr = "C17" 'Dia chi ket qua
 
  sArr = Range(sRngStr).Value 'Gán du lieu vào mang du lieu
  sR = UBound(sArr) - (n - 1 + m - 1) 'so dong mang ket qua
  For mk = 1 To m 'Chay mang ket qua mk
    ReDim Res(1 To sR, 1 To UBound(sArr, 2)) 'Khai báo mang ket qua voi so dòng: sR và so cot: UBound(sArr, 2)
    For i = 1 To sR 'Chay tu dong dau toi dòng cuoi mang ket qua
      For j = 1 To UBound(sArr, 2) 'Chay tu cot dau toi cot cuoi
        If TypeName(sArr(i, j)) = "Double" Then 'Neu có du lieu
          For nk = 0 To n - 1
            Res(i, j) = Res(i, j) + sArr(i + mk + nk - 1, j) 'tính ket qua
          Next nk
        End If
      Next j
    Next i
  Range(rRngStr).Offset((mk - 1) * (sR + d)).Resize(sR, UBound(Res, 2)) = Res 'gán ket qua vào dia chi ket qua
  Next mk
End Sub
Nhấp chuột vào đây để mở rộng...
Bác ơi, cháu đã sửa lại code như này mà tại sao áp dụng cho bài này lại không được bác nhỉ. cháu đã cho thêm vào vòng lặp "Z" nữa rồi. Bác chỉ giùm cháu với.
Sub GPE5() 'tong quat
Dim sArr() 'Mang du lieu
Dim Res() 'Mang ket qua
Dim i As Long, j As Long, sR As Long, mk As Byte, nk As Byte, z As Byte
Const n = 2 + z 'so dòng cong
Const m = 3 'so mang ket qua
Const d = 2 'Só dòng trong giua 2 ket qua
Const sRngStr = "C2:AA13" 'Dia chi vùng du lieu
Const rRngStr = "C17" 'Dia chi ket qua

sArr = Range(sRngStr).Value 'Gán du lieu vào mang du lieu
sR = UBound(sArr) - (n - 1 + m - 1) 'so dong mang ket qua
For mk = 1 To m 'Chay mang ket qua mk
ReDim Res(1 To sR, 1 To UBound(sArr, 2)) 'Khai báo mang ket qua voi so dòng: sR và so cot: UBound(sArr, 2)
For i = 1 To sR 'Chay tu dong dau toi dòng cuoi mang ket qua
For j = 1 To UBound(sArr, 2) 'Chay tu cot dau toi cot cuoi
If TypeName(sArr(i, j)) = "Double" Then 'Neu có du lieu
For z = 1 To 2
For nk = 0 To n - 1
Res(i, j) = Res(i, j) + sArr(i + mk + nk - 1, j) 'tính ket qua
Next z
Next nk
End If
Next j
Next i
Range(rRngStr).Offset((mk - 1) * (sR + d)).Resize(sR, UBound(Res, 2)) = Res 'gán ket qua vào dia chi ket qua
Next mk
End Sub
Cháu cảm ơn bác!
 

File đính kèm

hongphuong1997 đã viết:
Bác ơi, cháu đã sửa lại code như này mà tại sao áp dụng cho bài này lại không được bác nhỉ. cháu đã cho thêm vào vòng lặp "Z" nữa rồi. Bác chỉ giùm cháu với.
Sub GPE5() 'tong quat
Dim sArr() 'Mang du lieu
Dim Res() 'Mang ket qua
Dim i As Long, j As Long, sR As Long, mk As Byte, nk As Byte, z As Byte
Const n = 2 + z 'so dòng cong
Const m = 3 'so mang ket qua
Const d = 2 'Só dòng trong giua 2 ket qua
Const sRngStr = "C2:AA13" 'Dia chi vùng du lieu
Const rRngStr = "C17" 'Dia chi ket qua

sArr = Range(sRngStr).Value 'Gán du lieu vào mang du lieu
sR = UBound(sArr) - (n - 1 + m - 1) 'so dong mang ket qua
For mk = 1 To m 'Chay mang ket qua mk
ReDim Res(1 To sR, 1 To UBound(sArr, 2)) 'Khai báo mang ket qua voi so dòng: sR và so cot: UBound(sArr, 2)
For i = 1 To sR 'Chay tu dong dau toi dòng cuoi mang ket qua
For j = 1 To UBound(sArr, 2) 'Chay tu cot dau toi cot cuoi
If TypeName(sArr(i, j)) = "Double" Then 'Neu có du lieu
For z = 1 To 2
For nk = 0 To n - 1
Res(i, j) = Res(i, j) + sArr(i + mk + nk - 1, j) 'tính ket qua
Next z
Next nk
End If
Next j
Next i
Range(rRngStr).Offset((mk - 1) * (sR + d)).Resize(sR, UBound(Res, 2)) = Res 'gán ket qua vào dia chi ket qua
Next mk
End Sub
Cháu cảm ơn bác!
Nhấp chuột vào đây để mở rộng...
Có nhiều chổ chưa chuẩn code báo lổi:
1/ Const n = 2 + z: gán trực tiếp giá trị không được dùng biến

2/ For z = 1 To 2
For nk = 0 To n - 1
Res(i, j) = Res(i, j) + sArr(i + mk + nk - 1, j) 'tính ket qua
Next z
Next nk
Biến của For và next không tương ứng

Phân tích giải thuật: số dòng cộng lệ thuộc vào biến mảng kết quả, nên không cần For Z, chỉ cần For nk = 0 To n - 1 + ???.
??? là biểu thức theo mk
 
HieuCD đã viết:
Có nhiều chổ chưa chuẩn code báo lổi:
1/ Const n = 2 + z: gán trực tiếp giá trị không được dùng biến

2/ For z = 1 To 2
For nk = 0 To n - 1
Res(i, j) = Res(i, j) + sArr(i + mk + nk - 1, j) 'tính ket qua
Next z
Next nk
Biến của For và next không tương ứng

Phân tích giải thuật: số dòng cộng lệ thuộc vào biến mảng kết quả, nên không cần For Z, chỉ cần For nk = 0 To n - 1 + ???.
??? là biểu thức theo mk
Nhấp chuột vào đây để mở rộng...
Hu hu... khó quá bác ui..
 
HieuCD đã viết:
Tập viết code các tình huống đơn giản trước, khi đã quen tìm mối liên hệ giửa các biến thể hiện qua các biểu thức tính lúc đó mới nâng cấp độ khó lên
Nhấp chuột vào đây để mở rộng...
Bác ơi cháu thử mãi theo gợ ý của bác mà không được bác à. Bác thêm biểu thức giúp cháu với.
Cháu cảm ơn bác!
 
hongphuong1997 đã viết:
Bác ơi cháu thử mãi theo gợ ý của bác mà không được bác à. Bác thêm biểu thức giúp cháu với.
Cháu cảm ơn bác!
Nhấp chuột vào đây để mở rộng...
Mã: 
Sub GPE5() 'tong quat
  Dim sArr() 'Mang du lieu
  Dim Res() 'Mang ket qua
  Dim i As Long, j As Long, sR As Long, mk As Byte, nk As Byte
  Const n = 2  'so dòng cong
  Const m = 3 'so mang ket qua
  Const d = 2 'Só dòng trong giua 2 ket qua
  Const sRngStr = "C2:AA13" 'Dia chi vùng du lieu
  Const rRngStr = "C17" 'Dia chi ket qua
 
  sArr = Range(sRngStr).Value 'Gán du lieu vào mang du lieu
  sR = UBound(sArr) - (n - 1 + m - 1) 'so dong mang ket qua
  For mk = 1 To m 'Chay mang ket qua mk
    ReDim Res(1 To sR, 1 To UBound(sArr, 2)) 'Khai báo mang ket qua voi so dòng: sR và so cot: UBound(sArr, 2)
    For i = 1 To sR 'Chay tu dong dau toi dòng cuoi mang ket qua
      For j = 1 To UBound(sArr, 2) 'Chay tu cot dau toi cot cuoi
        If TypeName(sArr(i, j)) = "Double" Then 'Neu có du lieu
          For nk = 0 To n - 1 + mk - 1
            Res(i, j) = Res(i, j) + sArr(i + nk - 1 + m + n - mk - 1, j) 'tính ket qua
          Next nk
        End If
      Next j
    Next i
    Range(rRngStr).Offset((mk - 1) * (sR + d)).Resize(sR, UBound(Res, 2)) = Res 'gán ket qua vào dia chi ket qua
  Next mk
End Sub
 
HieuCD đã viết:
Mã: 
Sub GPE5() 'tong quat
  Dim sArr() 'Mang du lieu
  Dim Res() 'Mang ket qua
  Dim i As Long, j As Long, sR As Long, mk As Byte, nk As Byte
  Const n = 2  'so dòng cong
  Const m = 3 'so mang ket qua
  Const d = 2 'Só dòng trong giua 2 ket qua
  Const sRngStr = "C2:AA13" 'Dia chi vùng du lieu
  Const rRngStr = "C17" 'Dia chi ket qua

  sArr = Range(sRngStr).Value 'Gán du lieu vào mang du lieu
  sR = UBound(sArr) - (n - 1 + m - 1) 'so dong mang ket qua
  For mk = 1 To m 'Chay mang ket qua mk
    ReDim Res(1 To sR, 1 To UBound(sArr, 2)) 'Khai báo mang ket qua voi so dòng: sR và so cot: UBound(sArr, 2)
    For i = 1 To sR 'Chay tu dong dau toi dòng cuoi mang ket qua
      For j = 1 To UBound(sArr, 2) 'Chay tu cot dau toi cot cuoi
        If TypeName(sArr(i, j)) = "Double" Then 'Neu có du lieu
          For nk = 0 To n - 1 + mk - 1
            Res(i, j) = Res(i, j) + sArr(i + nk - 1 + m + n - mk - 1, j) 'tính ket qua
          Next nk
        End If
      Next j
    Next i
    Range(rRngStr).Offset((mk - 1) * (sR + d)).Resize(sR, UBound(Res, 2)) = Res 'gán ket qua vào dia chi ket qua
  Next mk
End Sub
Nhấp chuột vào đây để mở rộng...
Cháu cảm ơn bác rất nhiều! Bác chỉnh sửa 2 chỗ... Thế mà cháu cứ loay hoay không biết cộng trừ ra sao nữa.
 
Vì các mảng có tính chất kế thừa nên bài này chỉ cần 3 vòng lặp.

Kiểu mì ăn liền
PHP: 
Sub Test_MiAnLien()
Const SoPhanTu As Long = 4
Dim MangGoc As Variant, MangKetQua As Variant, ViTriDatKetQua As Range, SoDong As Long, SoCot As Long, i As Long, j As Long, k As Long
MangGoc = Sheet1.Range("C2:AA13").Value
Set ViTriDatKetQua = Sheet1.Range("C17")
SoDong = UBound(MangGoc, 1) - SoPhanTu + 1
SoCot = UBound(MangGoc, 2)
If SoDong < 1 Then Exit Sub
ReDim MangKetQua(1 To SoDong, 1 To SoCot)
For k = 1 To SoPhanTu
    For i = 1 To SoDong
        For j = 1 To SoCot
            MangKetQua(i, j) = MangKetQua(i, j) + MangGoc(i + SoPhanTu - k, j)
        Next
    Next
    If k > 1 Then
        ViTriDatKetQua.Resize(SoDong, SoCot).Value = MangKetQua
        Set ViTriDatKetQua = ViTriDatKetQua.Offset(SoDong + 2)
    End If
Next
End Sub
Kiểu tổng quát
PHP: 
Sub Test_TongQuat()
TaoMangCongDon Sheet1.Range("C2:AA13").Value, 4, Sheet1.Range("C17")
End Sub
Sub TaoMangCongDon(ByVal MangGoc As Variant, ByVal SoPhanTu As Long, ByVal ViTriDatKetQua As Range)
Dim MangKetQua As Variant, PhanTuKetQua As Variant, SoDong As Long, i As Long
ReDim MangKetQua(1 To SoPhanTu)
SoDong = UBound(MangGoc, 1) - LBound(MangGoc, 1) + 1 - SoPhanTu + 1
SoCot = UBound(MangGoc, 2) - LBound(MangGoc, 2) + 1
If SoDong > 0 Then
    ReDim PhanTuKetQua(LBound(MangGoc, 1) + SoPhanTu - 1 To UBound(MangGoc, 1), LBound(MangGoc, 2) To UBound(MangGoc, 2))
    For i = 1 To SoPhanTu
        CongMang PhanTuKetQua, MangGoc, -(i - 1)
        MangKetQua(i) = PhanTuKetQua
    Next
    ViTriDatKetQua.Resize((SoPhanTu - 1) * (SoDong + 2), SoCot).ClearContents
    For i = 2 To SoPhanTu
        ViTriDatKetQua.Resize(SoDong, SoCot).Value = MangKetQua(i)
        Set ViTriDatKetQua = ViTriDatKetQua.Offset(SoDong + 2)
    Next
Else
    MsgBox "So phan tu vuot qua kich thuoc mang goc"
End If
End Sub
Private Sub CongMang(ByRef MangGoc As Variant, ByRef MangCong As Variant, ByVal ViTriTuongDoi As Long)
Dim i As Long, j As Long
For i = LBound(MangGoc, 1) To UBound(MangGoc, 1)
    For j = LBound(MangGoc, 2) To UBound(MangGoc, 2)
        MangGoc(i, j) = MangGoc(i, j) + MangCong(i + ViTriTuongDoi, j)
    Next
Next
End Sub
 

File đính kèm

PacificPR đã viết:
3 giờ mà còn đang mần mò làm. Kiểu này khoảng tháng nữa là thành cao thủ rồi -\\/.
Nhấp chuột vào đây để mở rộng...
hi hi... em nằm ngủ cũng mơ thấy code chị à, nhưng em thấy khó quá. Khó hơn tất cả các môn em đã và đang học chị à.
Bài đã được tự động gộp:

huuthang_bd đã viết:
Vì các mảng có tính chất kế thừa nên bài này chỉ cần 3 vòng lặp.

Kiểu mì ăn liền
PHP: 
Sub Test_MiAnLien()
Const SoPhanTu As Long = 4
Dim MangGoc As Variant, MangKetQua As Variant, ViTriDatKetQua As Range, SoDong As Long, SoCot As Long, i As Long, j As Long, k As Long
MangGoc = Sheet1.Range("C2:AA13").Value
Set ViTriDatKetQua = Sheet1.Range("C17")
SoDong = UBound(MangGoc, 1) - SoPhanTu + 1
SoCot = UBound(MangGoc, 2)
If SoDong < 1 Then Exit Sub
ReDim MangKetQua(1 To SoDong, 1 To SoCot)
For k = 1 To SoPhanTu
    For i = 1 To SoDong
        For j = 1 To SoCot
            MangKetQua(i, j) = MangKetQua(i, j) + MangGoc(i + SoPhanTu - k, j)
        Next
    Next
    If k > 1 Then
        ViTriDatKetQua.Resize(SoDong, SoCot).Value = MangKetQua
        Set ViTriDatKetQua = ViTriDatKetQua.Offset(SoDong + 2)
    End If
Next
End Sub
Kiểu tổng quát
PHP: 
Sub Test_TongQuat()
TaoMangCongDon Sheet1.Range("C2:AA13").Value, 4, Sheet1.Range("C17")
End Sub
Sub TaoMangCongDon(ByVal MangGoc As Variant, ByVal SoPhanTu As Long, ByVal ViTriDatKetQua As Range)
Dim MangKetQua As Variant, PhanTuKetQua As Variant, SoDong As Long, i As Long
ReDim MangKetQua(1 To SoPhanTu)
SoDong = UBound(MangGoc, 1) - LBound(MangGoc, 1) + 1 - SoPhanTu + 1
SoCot = UBound(MangGoc, 2) - LBound(MangGoc, 2) + 1
If SoDong > 0 Then
    ReDim PhanTuKetQua(LBound(MangGoc, 1) + SoPhanTu - 1 To UBound(MangGoc, 1), LBound(MangGoc, 2) To UBound(MangGoc, 2))
    For i = 1 To SoPhanTu
        CongMang PhanTuKetQua, MangGoc, -(i - 1)
        MangKetQua(i) = PhanTuKetQua
    Next
    ViTriDatKetQua.Resize((SoPhanTu - 1) * (SoDong + 2), SoCot).ClearContents
    For i = 2 To SoPhanTu
        ViTriDatKetQua.Resize(SoDong, SoCot).Value = MangKetQua(i)
        Set ViTriDatKetQua = ViTriDatKetQua.Offset(SoDong + 2)
    Next
Else
    MsgBox "So phan tu vuot qua kich thuoc mang goc"
End If
End Sub
Private Sub CongMang(ByRef MangGoc As Variant, ByRef MangCong As Variant, ByVal ViTriTuongDoi As Long)
Dim i As Long, j As Long
For i = LBound(MangGoc, 1) To UBound(MangGoc, 1)
    For j = LBound(MangGoc, 2) To UBound(MangGoc, 2)
        MangGoc(i, j) = MangGoc(i, j) + MangCong(i + ViTriTuongDoi, j)
    Next
Next
End Sub
Nhấp chuột vào đây để mở rộng...
Cháu cảm ơn bác @huuthang_bd rất nhiều, cháu lại học thêm được một thuật toán nữa roài.
Cháu chúc bác vạn sự thành công như ý!
 
Giải quyết vấn đề thì như vầy được rồi, nhưng gọi là học bài thì chẳng tới chốn đâu.
Muốn học sử dụng mảng nhiều chiều thì đầu tiên hết phải tìm hiểu cái ngôn ngữ đó nó xếp mảng theo cột hay theo dòng. Nếu mảng lớn thì sử lý đúng chiều nó nhanh hơn.
 
VetMini đã viết:
Giải quyết vấn đề thì như vầy được rồi, nhưng gọi là học bài thì chẳng tới chốn đâu.
Muốn học sử dụng mảng nhiều chiều thì đầu tiên hết phải tìm hiểu cái ngôn ngữ đó nó xếp mảng theo cột hay theo dòng. Nếu mảng lớn thì sử lý đúng chiều nó nhanh hơn.
Nhấp chuột vào đây để mở rộng...
Cảm ơn bác @VetMini đã chỉ dẫn, bác ơi bác giải thích và làm ví dụ cụ thể cho cháu với,.
Cháu cảm ơn bác!
 
hongphuong1997 đã viết:
Cảm ơn bác @VetMini đã chỉ dẫn, bác ơi bác giải thích và làm ví dụ cụ thể cho cháu với,.
Cháu cảm ơn bác!
Nhấp chuột vào đây để mở rộng...

Cái tôi nói nó là lý thuyết, làm sao mà cụ thể được.
Gợi ý: chịu khó đọc bài trong mục "những câu hỏi về mảng"
Nếu bạn không biết lựa bài của ai để đọc thì chịu khó tho dõi một thời gian nữa. Hiện nay (*), ở diễn đàn này chỉ có 2 người (nhắc lại, con số 2, không hơn không kém) nói chuyện về lý thuyết.

Chú: tôi nói theo "hiện nay". Trước đây cũng có ngừoi nói chuyện lý thuyết nhưng những người này đã bỏ đi rồi.
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

T
  • Question Question
Xin code VBA trả về tên tài khoản theo điều kiện
    • Chấp nhận
Trả lời
12
Đọc
370
VetMini
V
mucongnghenhat
lỗi đoạn văn bản bị đóng khung
Trả lời
0
Đọc
24
mucongnghenhat
mucongnghenhat
HeSanbi
  • Question Question
VBA Nâng cao: Hướng dẫn tạo biểu thức tìm kiếm với Regular Expression
    • Thích
    • Yêu thích
Trả lời
8
Đọc
579
nguyendang95
N
Uyên dương Hoya
Lỗi định dạng form chữ trong excel
Trả lời
1
Đọc
58
DeTong
D
ntnguyentam1907
Lấy bảng dữ liệu chứng khoán về excel
2
Trả lời
22
Đọc
3K
nguyendang95
N
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Cảm ơn
Trả lời
5
Đọc
756
hoangtuan.net
hoangtuan.net
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Chấp nhận
2
Trả lời
35
Đọc
13K
minhys1
M
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
14 15 16
Trả lời
305
Đọc
21K
pkt.bacdau
pkt.bacdau
HONGVY91
Đếm số lượng 2 cột và đếm không trùng
Trả lời
2
Đọc
115
hoangtuaotrang_hp_vn
H
hanhlx88
Nhờ giúp file Excel báo lỗi: Excel cannot complete this task with available resources
Trả lời
3
Đọc
180
hanhlx88
hanhlx88
C
Trách nhiệm pháp lý của chi nhánh doanh nghiệp Việt Nam tại nước ngoài với Công ty tại Việt Nam
Trả lời
3
Đọc
105
VetMini
V
HeSanbi
  • Đã giải quyết
LocalizeXL v1.73 - Làm nổi bật ô đang chọn và cuộn trang tự động
    • Thích
    • Yêu thích
2 3 4
Trả lời
73
Đọc
10K
HeSanbi
HeSanbi
L
Folder chứa chương trình bị khóa bởi Lock folder
2
Trả lời
28
Đọc
25K
qthangvphaui
Q
P
Xin trợ giúp cách lập lịch trực tịnh tiến dần cho 1 nhóm người.
Trả lời
4
Đọc
142
phambahoang
P
N
Tính tổng với điều kiện gần đúng
Trả lời
3
Đọc
64
HUONGHCKT
H
Bùi Thúy Thúy
  • Question Question
Lấy dữ liệu thời tiết Accuweather để điền vào nhật ký thi công
2 3 4
Trả lời
63
Đọc
19K
Mutants Men
M
Anxseo
  • Đã khóa
Cách crack my excel
Trả lời
1
Đọc
173
HeSanbi
HeSanbi
phatnguyen7301
  • Question Question
Tạo âm thanh khi nhấn vào một phím
Trả lời
5
Đọc
245
yaaasoo01
Y
anhtuan1066
  • Question Question
Chèn hình vào cell bằng hàm tự tạo
    • Thích
    • Ngạc nhiên
10 11 12
Trả lời
235
Đọc
106K
XaNguyen
X
vc_đi chơi
Khóa Hoặc mã hóa File excel có độ bảo mật cao
    • Cảm ơn
    • Thích
Trả lời
3
Đọc
203
Hoangkhang01213
Hoangkhang01213
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới.
Back
Top Bottom