VBA cộng mảng liên tục và gián đoạn (1 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
hongphuong1997

hongphuong1997

Thành viên tiêu biểu
Tham gia
12/11/17
Bài viết
773
Được thích
323
Giới tính
Nữ
Kính nhờ các bác và các anh, chị giúp đỡ viết code bài toán về phép cộng mảng bằng cách đơn giản nhưng đầy đủ và dễ hiểu nhất
Cảm ơn!
 

File đính kèm

Các anh chị ơi giúp em với, Anh @Ba Tê bác @HieuCD ơi giúp cháu bài này với ạ!
 
hongphuong1997 đã viết:
Kính nhờ các bác và các anh, chị giúp đỡ viết code bài toán về phép cộng mảng bằng cách đơn giản nhưng đầy đủ và dễ hiểu nhất
Cảm ơn!
Nhấp chuột vào đây để mở rộng...
Không cần 2 code, chỉ cần khai báo lại địa chỉ thích hợp
Mã: 
Sub GPE()
  Dim sArr(), Res()
  Dim i As Long, j As Long, sR As Long
'Khai báo vùng du lieu và ket qua
  Const sRngStr = "C2:AA13" 'Dia chi vùng du lieu
  Const rRngStr = "C17" 'Dia chi ket qua
  'Const sRngStr = "C35:X46"
  'Const rRngStr = "C50"
  sArr = Range(sRngStr).Value
  sR = UBound(sArr) - 1
  ReDim Res(1 To sR, 1 To UBound(sArr, 2))
  For i = 1 To sR
    For j = 1 To UBound(sArr, 2)
      If TypeName(sArr(i, j)) = "Double" Then Res(i, j) = sArr(i, j) + sArr(i + 1, j)
    Next j
  Next i
  Range(rRngStr).Resize(sR, UBound(Res, 2)) = Res
End Sub
 
HieuCD đã viết:
Không cần 2 code, chỉ cần khai báo lại địa chỉ thích hợp
Mã: 
Sub GPE()
  Dim sArr(), Res()
  Dim i As Long, j As Long, sR As Long
'Khai báo vùng du lieu và ket qua
  Const sRngStr = "C2:AA13" 'Dia chi vùng du lieu
  Const rRngStr = "C17" 'Dia chi ket qua
  'Const sRngStr = "C35:X46"
  'Const rRngStr = "C50"
  sArr = Range(sRngStr).Value
  sR = UBound(sArr) - 1
  ReDim Res(1 To sR, 1 To UBound(sArr, 2))
  For i = 1 To sR
    For j = 1 To UBound(sArr, 2)
      If TypeName(sArr(i, j)) = "Double" Then Res(i, j) = sArr(i, j) + sArr(i + 1, j)
    Next j
  Next i
  Range(rRngStr).Resize(sR, UBound(Res, 2)) = Res
End Sub
Nhấp chuột vào đây để mở rộng...
Cháu cảm ơn bác @HieuCD , bác ơi bác làm ơn giải thích cho cháu với.
 
hongphuong1997 đã viết:
Cháu cảm ơn bác @HieuCD , bác ơi bác làm ơn giải thích cho cháu với.
Nhấp chuột vào đây để mở rộng...
Đọc ghi chú trong code
Mã: 
Sub GPE()
  Dim sArr() 'Mang du lieu
  Dim Res() 'Mang ket qua
  Dim i As Long, j As Long, sR As Long
'Khai báo vùng du lieu và ket qua
  Const sRngStr = "C2:AA13" 'Dia chi vùng du lieu
  Const rRngStr = "C17" 'Dia chi ket qua
  'Const sRngStr = "C35:X46"
  'Const rRngStr = "C50"
  sArr = Range(sRngStr).Value 'Gán du lieu vào mang du lieu
  sR = UBound(sArr) - 1 'so dong mang ket qua, it hon mang du lieu 1 dòng
  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
        Res(i, j) = sArr(i, j) + sArr(i + 1, j) 'tính ket qua
      End If
    Next j
  Next i
  Range(rRngStr).Resize(sR, UBound(Res, 2)) = Res 'gán ket qua vào dia chi ket qua
End Sub
 
HieuCD đã viết:
Đọc ghi chú trong code
Mã: 
Sub GPE()
  Dim sArr() 'Mang du lieu
  Dim Res() 'Mang ket qua
  Dim i As Long, j As Long, sR As Long
'Khai báo vùng du lieu và ket qua
  Const sRngStr = "C2:AA13" 'Dia chi vùng du lieu
  Const rRngStr = "C17" 'Dia chi ket qua
  'Const sRngStr = "C35:X46"
  'Const rRngStr = "C50"
  sArr = Range(sRngStr).Value 'Gán du lieu vào mang du lieu
  sR = UBound(sArr) - 1 'so dong mang ket qua, it hon mang du lieu 1 dòng
  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
        Res(i, j) = sArr(i, j) + sArr(i + 1, j) 'tính ket qua
      End If
    Next j
  Next i
  Range(rRngStr).Resize(sR, UBound(Res, 2)) = Res 'gán ket qua vào dia chi ket qua
End Sub
Nhấp chuột vào đây để mở rộng...
Cháu cảm ơn bác. cháu hỏi thêm bác tý nhé! Thế cháu muốn cộng 3 hoặc nhiều số liên tiếp (Không phải là cộng 2 số như ví dụ) thì phải thay đổi như nào hả bác?
 
hongphuong1997 đã viết:
Cháu cảm ơn bác. cháu hỏi thêm bác tý nhé! Thế cháu muốn cộng 3 hoặc nhiều số liên tiếp (Không phải là cộng 2 số như ví dụ) thì phải thay đổi như nào hả bác?
Nhấp chuột vào đây để mở rộng...
Thêm biến n để hiểu cách
Mã: 
Sub GPE()
  Dim sArr() 'Mang du lieu
  Dim Res() 'Mang ket qua
  Dim i As Long, j As Long, sR As Long
  Const n = 3
'Khai báo vùng du lieu và ket qua
  Const sRngStr = "C2:AA13" 'Dia chi vùng du lieu
  Const rRngStr = "C17" 'Dia chi ket qua
  'Const sRngStr = "C35:X46"
  'Const rRngStr = "C50"
  sArr = Range(sRngStr).Value 'Gán du lieu vào mang du lieu
  sR = UBound(sArr) - (n - 1) 'so dong mang ket qua, it hon mang du lieu n-1 dòng
  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
        Res(i, j) = sArr(i, j) + sArr(i + 1, j) + sArr(i + 2, j) 'tính ket qua
      End If
    Next j
  Next i
  Range(rRngStr).Resize(sR, UBound(Res, 2)) = Res 'gán ket qua vào dia chi ket qua
End Sub
Hoặc viết lại tổng quát hơn, chưa bẩy lổi n lớn hơn số dòng dữ liệu
Mã: 
Sub GPE1()
  Dim sArr() 'Mang du lieu
  Dim Res() 'Mang ket qua
  Dim i As Long, j As Long, sR As Long, k As Byte
  Const n = 3 'so dòng cong
  Const sRngStr = "C2:AA13" 'Dia chi vùng du lieu
  Const rRngStr = "C17" 'Dia chi ket qua
  'Const sRngStr = "C35:X46"
  'Const rRngStr = "C50"
  
  sArr = Range(sRngStr).Value 'Gán du lieu vào mang du lieu
  sR = UBound(sArr) - (n - 1) 'so dong mang ket qua, it hon mang du lieu n-1 dòng
  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 k = 0 To n - 1
          Res(i, j) = Res(i, j) + sArr(i + k, j) 'tính ket qua
        Next k
      End If
    Next j
  Next i
  Range(rRngStr).Resize(sR, UBound(Res, 2)) = Res 'gán ket qua vào dia chi ket qua
End Sub
 
HieuCD đã viết:
Thêm biến n để hiểu cách
Mã: 
Sub GPE()
  Dim sArr() 'Mang du lieu
  Dim Res() 'Mang ket qua
  Dim i As Long, j As Long, sR As Long
  Const n = 3
'Khai báo vùng du lieu và ket qua
  Const sRngStr = "C2:AA13" 'Dia chi vùng du lieu
  Const rRngStr = "C17" 'Dia chi ket qua
  'Const sRngStr = "C35:X46"
  'Const rRngStr = "C50"
  sArr = Range(sRngStr).Value 'Gán du lieu vào mang du lieu
  sR = UBound(sArr) - (n - 1) 'so dong mang ket qua, it hon mang du lieu n-1 dòng
  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
        Res(i, j) = sArr(i, j) + sArr(i + 1, j) + sArr(i + 2, j) 'tính ket qua
      End If
    Next j
  Next i
  Range(rRngStr).Resize(sR, UBound(Res, 2)) = Res 'gán ket qua vào dia chi ket qua
End Sub
Hoặc viết lại tổng quát hơn, chưa bẩy lổi n lớn hơn số dòng dữ liệu
Mã: 
Sub GPE1()
  Dim sArr() 'Mang du lieu
  Dim Res() 'Mang ket qua
  Dim i As Long, j As Long, sR As Long, k As Byte
  Const n = 3 'so dòng cong
  Const sRngStr = "C2:AA13" 'Dia chi vùng du lieu
  Const rRngStr = "C17" 'Dia chi ket qua
  'Const sRngStr = "C35:X46"
  'Const rRngStr = "C50"
 
  sArr = Range(sRngStr).Value 'Gán du lieu vào mang du lieu
  sR = UBound(sArr) - (n - 1) 'so dong mang ket qua, it hon mang du lieu n-1 dòng
  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 k = 0 To n - 1
          Res(i, j) = Res(i, j) + sArr(i + k, j) 'tính ket qua
        Next k
      End If
    Next j
  Next i
  Range(rRngStr).Resize(sR, UBound(Res, 2)) = Res 'gán ket qua vào dia chi ket qua
End Sub
Nhấp chuột vào đây để mở rộng...
Cháu cảm ơn bác rất nhiều, Giá như cháu được học trực tiếp kiến thức của bác thì cháu sẽ nhanh giỏi lắm. Cháu cảm ơn bác ạ.
 
HieuCD đã viết:
Thêm biến n để hiểu cách
Mã: 
Sub GPE()
  Dim sArr() 'Mang du lieu
  Dim Res() 'Mang ket qua
  Dim i As Long, j As Long, sR As Long
  Const n = 3
'Khai báo vùng du lieu và ket qua
  Const sRngStr = "C2:AA13" 'Dia chi vùng du lieu
  Const rRngStr = "C17" 'Dia chi ket qua
  'Const sRngStr = "C35:X46"
  'Const rRngStr = "C50"
  sArr = Range(sRngStr).Value 'Gán du lieu vào mang du lieu
  sR = UBound(sArr) - (n - 1) 'so dong mang ket qua, it hon mang du lieu n-1 dòng
  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
        Res(i, j) = sArr(i, j) + sArr(i + 1, j) + sArr(i + 2, j) 'tính ket qua
      End If
    Next j
  Next i
  Range(rRngStr).Resize(sR, UBound(Res, 2)) = Res 'gán ket qua vào dia chi ket qua
End Sub
Hoặc viết lại tổng quát hơn, chưa bẩy lổi n lớn hơn số dòng dữ liệu
Mã: 
Sub GPE1()
  Dim sArr() 'Mang du lieu
  Dim Res() 'Mang ket qua
  Dim i As Long, j As Long, sR As Long, k As Byte
  Const n = 3 'so dòng cong
  Const sRngStr = "C2:AA13" 'Dia chi vùng du lieu
  Const rRngStr = "C17" 'Dia chi ket qua
  'Const sRngStr = "C35:X46"
  'Const rRngStr = "C50"
 
  sArr = Range(sRngStr).Value 'Gán du lieu vào mang du lieu
  sR = UBound(sArr) - (n - 1) 'so dong mang ket qua, it hon mang du lieu n-1 dòng
  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 k = 0 To n - 1
          Res(i, j) = Res(i, j) + sArr(i + k, j) 'tính ket qua
        Next k
      End If
    Next j
  Next i
  Range(rRngStr).Resize(sR, UBound(Res, 2)) = Res 'gán ket qua vào dia chi ket qua
End Sub
Nhấp chuột vào đây để mở rộng...
Cháu chào Bác @HieuCD, Bác ơi bác giúp cho cháu đoạn code và chỉ dẫn cho cháu với bác nhé, Cháu cảm ơn bác!
 

File đính kèm

Thắc mắc: Bài này ứng dụng vào việc gì?
(Làm thì được nhưng tôi ít khi thích làm cộng việc mơ hồ)
 
ndu96081631 đã viết:
Thắc mắc: Bài này ứng dụng vào việc gì?
(Làm thì được nhưng tôi ít khi thích làm cộng việc mơ hồ)
Nhấp chuột vào đây để mở rộng...
Dạ, cháu học cách để tịnh tiến mảng thôi bác à, không ứng dụng vào việc gì bác
ndu96081631
à. Bác viết giúp cho cháu làm sao để dễ hiểu nhất và nguyên lý của nó bác à,
 
Hí hí. Vậy là 2 ngày nay Bác @HieuCD làm công cốc rùi. Bác HieuCD của cháu ui :p:p:p
 
Mình cũng mới học thôi. Mà chủ yếu là đi học lỏm 2 Bác yêu của bạn đó
 
hongphuong1997 đã viết:
Dạ, cháu học cách để tịnh tiến mảng thôi bác à
Nhấp chuột vào đây để mở rộng...
PHP: 
Sub GPE()
Dim sArr(), I As Long, J As Long, K As Long, N As Long, Rws As Long
sArr = Range("C2").Resize(12, 25).Value
Rws = 17
For N = 1 To 3
    ReDim dArr(1 To 9, 1 To 25)
    K = 0
    For I = N To N + 8
        K = K + 1
        For J = 1 To 25
            dArr(K, J) = sArr(I, J) + sArr(I + 1, J)
        Next J
    Next I
    Range("AC" & Rws).Resize(9, 25) = dArr       '----Gán vào cột nào đó.'
    Rws = Rws + 11
Next N
End Sub
 
hongphuong1997 đã viết:
Cháu chào Bác @HieuCD, Bác ơi bác giúp cho cháu đoạn code và chỉ dẫn cho cháu với bác nhé, Cháu cảm ơn bác!
Nhấp chuột vào đây để mở rộng...
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
 
Ba Tê đã viết:
PHP: 
Sub GPE()
Dim sArr(), I As Long, J As Long, K As Long, N As Long, Rws As Long
sArr = Range("C2").Resize(12, 25).Value
Rws = 17
For N = 1 To 3
    ReDim dArr(1 To 9, 1 To 25)
    K = 0
    For I = N To N + 8
        K = K + 1
        For J = 1 To 25
            dArr(K, J) = sArr(I, J) + sArr(I + 1, J)
        Next J
    Next I
    Range("AC" & Rws).Resize(9, 25) = dArr       '----Gán vào cột nào đó.'
    Rws = Rws + 11
Next N
End Sub
Nhấp chuột vào đây để mở rộng...
Em cảm ơn anh @Ba Tê đã chỉ bảo cho em, nhưng anh ơi em đang vọc vạch từ đầu mà anh bảo em tự làm thì làm sao em có thể làm được? Anh chỉ hướng đẫn em phong cách một số trường hợp cụ thể sau đó em sẽ phát huy được và có khả năng còn giỏi hơn mấy chị
♫ђöล♥ßล†♥†µ♫ và chị @Hương Liên ..... ấy chứ
 
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 đúng quá bác @HieuCD cháu cảm ơn bác! Bác là người thầy vĩ đại của cháu, đêm nay cháu nghiên cứu code này bác à, Cháu cảm ơn bác rất nhiều.
 
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...
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?
 
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.

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

E
Đánh số cho các cặp số chứng từ và số chứng từ đối ứng
Trả lời
16
Đọc
317
Phan Thế Hiệp
Phan Thế Hiệp
Y
Lấy dữ liệu từ sheet chi tiết sang sheet tổng hợp hàng dọc
Trả lời
5
Đọc
517
SA_DQ
SA_DQ
N
Hàm tính chuỗi số trong 1 ô hoặc 1 dãy ô ra tổng kết quả.
Trả lời
2
Đọc
91
minhminh27
minhminh27
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
382
Đọc
45K
TomRuoi
TomRuoi
NguyenthiH
Mở file Excel có Pass Open
Trả lời
39
Đọc
3K
Hoàng Tuấn 868
H
M
Tách dữ liệu trong 1 file thành nhiều sheet theo số lượng dòng
    • Ngạc nhiên
Trả lời
25
Đọc
3K
Hoàng Tuấn 868
H
T
Tìm số hóa đơn trong chuỗi
Trả lời
11
Đọc
419
thao nguyen01
T
T
  • Question Question
Nhờ ACE cao thủ hỗ trợ mình có một chương trình EXCEL về phân công lớp cho giáo viên
Trả lời
6
Đọc
318
DeTong
D
T
Nhờ các anh chị sửa dùm công thức ạ.
Trả lời
10
Đọc
207
trantrungvinh1989
T
C
Chia sẻ: Kết quả xổ số Keno
    • Cười
    • Thích
Trả lời
24
Đọc
2K
phuongdaik98
P
Phan Thế Hiệp
Quy đổi từ Thu nhập sau thuế (TNCN) ra Thu nhập tính thuế (1 người xem)
    • Yêu thích
    • Thích
Trả lời
1
Đọc
338
Phan Thế Hiệp
Phan Thế Hiệp
V
Quên mật khẩu file excel
Trả lời
25
Đọc
2K
YêuCN
Y
Nguyen Rem
  • Question Question
Lỗi "User-defined type not defined" khi khai báo biến
Trả lời
28
Đọc
2K
nguyendang95
N
OverAC
  • Dán lên cao
  • Suggestion Suggestion
Chúc mừng sinh nhật GiaiPhapExcel 19 tuổi và tặng ebook "Lập trình VBA phần cơ bản." (1 người xem)
    • Thích
    • Yêu thích
Trả lời
5
Đọc
1K
longlacda
L
V
Công thức để phân công chuyên môn cho giáo viên
Trả lời
5
Đọc
294
vietvanyen
V
G
AddIn convert ngày dương lịch sang âm lịch và ngược lại + đọc ngày tháng
Trả lời
20
Đọc
10K
du trung kien
D
8
Hàm trong excel
Trả lời
3
Đọc
118
Hoàng Tuấn 868
H
N
Chuyển giờ công từ bảng công vào bảng tính
Trả lời
16
Đọc
351
ngouyen1505
N
N
Tạo COM Add-In bằng Visual C++
    • Thích
Trả lời
7
Đọc
707
nguyendang95
N
Nga1852k
lỗi excel không chèn được dòng và không xóa được dòng
Trả lời
2
Đọc
154
Nga1852k
Nga1852k
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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom