sep_hatxel
Thành viên thường trực




- Tham gia
- 24/5/10
- Bài viết
- 217
- Được thích
- 7
A4=IF((Sheet1!A$4+Sheet1!A5)>=10;(Sheet1!A$4+Sheet1!A5)-10;(Sheet1!A$4+Sheet1!A5))
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: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!
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
Tại ô A4 sheet2 bạn gõ: =MOD((Sheet1!A$4+Sheet1!A5);10)
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.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
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
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.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.
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!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