Tìm hàng đơn vị của các tổng

Liên hệ QC

sep_hatxel

Thành viên thường trực
Tham gia
24/5/10
Bài viết
217
Được thích
7
Chúc GPE những điều tốt đẹp!
Mình có một file excel: Chân thành nhờ GPE giúp mình tìm hàng đơn vị của các tổng từ sheet1 xuất sang sheet2! Chân thành cảm ơn!
 

File đính kèm

  • Tìm hàng đơn vị của các tổng.rar
    5.1 KB · Đọc: 30
Tại ô A4 sheet2 bạn gõ: =MOD((Sheet1!A$4+Sheet1!A5);10)
 
Chúc GPE những điều tốt đẹp!
Mình có một file excel: Chân thành nhờ GPE giúp mình tìm hàng đơn vị của các tổng từ sheet1 xuất sang sheet2! Chân thành cảm ơn!
Dùng công thức thì dùng như các bạn, còn dùng code thì dùng thử code sau:
PHP:
Sub TinhTong()
Dim Arr(), ArrKQ()
Dim endR As Long, endC As Long, i As Long, j As Long
With Sheet1
  endR = .Cells(65000, 1).End(xlUp).Row - 3
  endC = .Cells(3, 256).End(xlToLeft).Column
  Arr = .Range("A4").Resize(endR, endC).Value
End With
endR = UBound(Arr, 1): endC = UBound(Arr, 2)
ReDim ArrKQ(1 To endR - 1, 1 To endC)
For i = 2 To endR
  For j = 1 To endC
    ArrKQ(i - 1, j) = (Arr(1, j) + Arr(i, j)) Mod 10
  Next j
Next i
With Sheet2
  .Range("A4").Resize(endR - 1, endC) = ArrKQ
End With
Erase Arr(), ArrKQ()
End Sub
 
Dùng công thức thì dùng như các bạn, còn dùng code thì dùng thử code sau:
PHP:
Sub TinhTong()
Dim Arr(), ArrKQ()
Dim endR As Long, endC As Long, i As Long, j As Long
With Sheet1
  endR = .Cells(65000, 1).End(xlUp).Row - 3
  endC = .Cells(3, 256).End(xlToLeft).Column
  Arr = .Range("A4").Resize(endR, endC).Value
End With
endR = UBound(Arr, 1): endC = UBound(Arr, 2)
ReDim ArrKQ(1 To endR - 1, 1 To endC)
For i = 2 To endR
  For j = 1 To endC
    ArrKQ(i - 1, j) = (Arr(1, j) + Arr(i, j)) Mod 10
  Next j
Next i
With Sheet2
  .Range("A4").Resize(endR - 1, endC) = ArrKQ
End With
Erase Arr(), ArrKQ()
End Sub
Code này hình như thiếu nghiệm đó bạn. Phải thêm một vòng lặp nữa mới được.
PHP:
Sub GPE()
Const FRow = 4
Dim EndRow As Long, EndCol As Long, i As Long, ii As Long, j As Long, k As Long, Data, Results(1 To 65000, 1 To 256)
Sheet2.[4:65536].ClearContents
EndRow = Sheet1.[A65536].End(xlUp).Row
EndCol = Sheet1.[IV3].End(xlToLeft).Column
Data = Range(Sheet1.Cells(FRow, 1), Sheet1.Cells(EndRow, EndCol)).Value
For i = 1 To EndRow - FRow
    For ii = i + 1 To EndRow - FRow + 1
    k = k + 1
    For j = 1 To EndCol
        Results(k, j) = (Data(ii, j) + Data(i, j)) Mod 10
    Next
    Next
Next
Sheet2.Cells(FRow, 1).Resize(k, EndCol).Value = Results
End Sub
Bài này bắt buộc phải dùng Macro. Các công thức của các bạn chỉ mới tính được dòng 1. Chưa tính được các dòng khác theo yêu cầu của tác giả.
 
Code này hình như thiếu nghiệm đó bạn. Phải thêm một vòng lặp nữa mới được.
Cám ơn Thắng nhiều, mới có xét dòng 1 với dòng i >1 mà quên. Bài này có làm rồi mà quên. Thì thêm 1 for nữa vậy.
PHP:
Sub TinhTong2()
Const FRow = 4
Dim Arr(), ArrKQ()
Dim endR As Long, endC As Long, i As Long, j As Long, k As Long, s As Long
With Sheet1
  endR = .Cells(65000, 1).End(xlUp).Row - FRow + 1
  endC = .Cells(3, 256).End(xlToLeft).Column
  Arr = .Range("A4").Resize(endR, endC).Value
End With
endR = UBound(Arr, 1): endC = UBound(Arr, 2)
ReDim ArrKQ(1 To endR * endR, 1 To endC): s = 0
For i = 1 To endR - 1
  For j = i + 1 To endR
    s = s + 1
    If s > 65536 - FRow Then GoTo Exit_Sub
    For k = 1 To endC
      ArrKQ(s, k) = (Arr(i, k) + Arr(j, k)) Mod 10
    Next k
  Next j
Next i
Exit_Sub:
With Sheet2
  .Range("A4").Resize(s, endC) = ArrKQ
End With
Erase Arr(), ArrKQ()
End Sub
 
Cám ơn Thắng nhiều, mới có xét dòng 1 với dòng i >1 mà quên. Bài này có làm rồi mà quên. Thì thêm 1 for nữa vậy.
PHP:
Sub TinhTong2()
Const FRow = 4
Dim Arr(), ArrKQ()
Dim endR As Long, endC As Long, i As Long, j As Long, k As Long, s As Long
With Sheet1
endR = .Cells(65000, 1).End(xlUp).Row - FRow + 1
endC = .Cells(3, 256).End(xlToLeft).Column
Arr = .Range("A4").Resize(endR, endC).Value
End With
endR = UBound(Arr, 1): endC = UBound(Arr, 2)
ReDim ArrKQ(1 To endR * endR, 1 To endC): s = 0
For i = 1 To endR - 1
For j = i + 1 To endR
s = s + 1
If s > 65536 - FRow Then GoTo Exit_Sub
For k = 1 To endC
ArrKQ(s, k) = (Arr(i, k) + Arr(j, k)) Mod 10
Next k
Next j
Next i
Exit_Sub:
With Sheet2
.Range("A4").Resize(s, endC) = ArrKQ
End With
Erase Arr(), ArrKQ()
End Sub
Vâng! Cảm ơn các bạn! Cảm ơn GPE! Các bạn không những giúp đúng theo ý mình mà còn mở rộng ra nhiều hơn! Tuyệt quá! Chúc GPE ngày càng vững mạnh! Thân ái!
 
Web KT

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

Back
Top Bottom