phuoclocvl
Thành viên thường trực
- Tham gia
- 28/3/12
- Bài viết
- 220
- Được thích
- 32
Lý do tách ra???Chào các Anh, Chị,
Em có 1 file excel như đính kèm, các anh chị giúp em code chia nhỏ số ra như trong file em có ghi.
Dạ cảm ơn,
Chào các Anh, Chị,
Em có 1 file excel như đính kèm, các anh chị giúp em code chia nhỏ số ra như trong file em có ghi.
Dạ cảm ơn,
Option Explicit
Public Sub GPE()
Dim sArr(), Res()
Dim i As Long, k As Long, sR As Long, eR As Long, j As Byte, sC As Byte
Dim Chuan As Double
With Sheets("Sheet1")
eR = .Range("O" & Rows.Count).End(xlUp).Row
If eR > 2 Then .Range("O3:X" & eR).ClearContents
eR = .Range("A65000").End(xlUp).Row
If eR < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
sArr = .Range("A3:J" & eR).Value
sR = UBound(sArr, 1): sC = UBound(sArr, 2)
End With
ReDim Res(1 To sR * 3, 1 To sC)
For i = 1 To sR
Chuan = sArr(i, 3)
Tiep:
k = k + 1
Res(k, 1) = sArr(i, 1): Res(k, 2) = sArr(i, 2): Res(k, 3) = Chuan
For j = 4 To sC
If sArr(i, j) > Chuan Then
Res(k, j) = Chuan
sArr(i, j) = sArr(i, j) - Chuan
Else
Res(k, j) = sArr(i, j)
sArr(i, j) = 0
End If
Next j
If k = sR * 3 Then
With Sheets("Sheet1")
eR = .Range("O" & Rows.Count).End(xlUp).Row + 1
.Range("O" & eR).Resize(k, sC) = Res
End With
k = 0
ReDim Res(1 To sR * 3, 1 To sC)
End If
For j = 4 To sC
If sArr(i, j) > 0 Then GoTo Tiep
Next j
Next i
If k > 0 Then
With Sheets("Sheet1")
eR = .Range("O" & Rows.Count).End(xlUp).Row + 1
.Range("O" & eR).Resize(k, sC) = Res
End With
End If
End Sub
Dạ cho em hỏiMã:Option Explicit Public Sub GPE() Dim sArr(), Res() Dim i As Long, k As Long, sR As Long, eR As Long, j As Byte, sC As Byte Dim Chuan As Double With Sheets("Sheet1") eR = .Range("O" & Rows.Count).End(xlUp).Row If eR > 2 Then .Range("O3:X" & eR).ClearContents eR = .Range("A65000").End(xlUp).Row If eR < 3 Then MsgBox ("Khong co du lieu"): Exit Sub sArr = .Range("A3:J" & eR).Value sR = UBound(sArr, 1): sC = UBound(sArr, 2) End With ReDim Res(1 To sR * 3, 1 To sC) For i = 1 To sR Chuan = sArr(i, 3) Tiep: k = k + 1 Res(k, 1) = sArr(i, 1): Res(k, 2) = sArr(i, 2): Res(k, 3) = Chuan For j = 4 To sC If sArr(i, j) > Chuan Then Res(k, j) = Chuan sArr(i, j) = sArr(i, j) - Chuan Else Res(k, j) = sArr(i, j) sArr(i, j) = 0 End If Next j If k = sR * 3 Then With Sheets("Sheet1") eR = .Range("O" & Rows.Count).End(xlUp).Row + 1 .Range("O" & eR).Resize(k, sC) = Res End With k = 0 ReDim Res(1 To sR * 3, 1 To sC) End If For j = 4 To sC If sArr(i, j) > 0 Then GoTo Tiep Next j Next i If k > 0 Then With Sheets("Sheet1") eR = .Range("O" & Rows.Count).End(xlUp).Row + 1 .Range("O" & eR).Resize(k, sC) = Res End With End If End Sub
Hi Bác,Lý do tách ra???
Tôi thì hiểu
M3517500425
tách 168 ra thành 5 dòng : 36+36+36+36+24
NHưng tự nhiên tách ra làm chi, tôi chỉ giúp khi hiểu việc có ích
Mảng kết quả có số dòng nhiều hơn mảng dữ liệu và không biết trước là bao nhiêu, có 2 cách để xử lýDạ cho em hỏi
Chổ này :ReDim Res(1 To sR * 3, 1 To sC) tại sao lại nhân với 3 ạ.
dạ cảm ơn,
Vâng , cảm ơn ạ,Mảng kết quả có số dòng nhiều hơn mảng dữ liệu và không biết trước là bao nhiêu, có 2 cách để xử lý
Cách 1, dùng 1 vòng For để tính số dòng mảng kết quả
Cách 2, áng chừng số dòng hợp lý mảng kết quả, mình chọn *3 có thể *2, *5 cũng được, nhiều quá tốn bộ nhớ có thể code chạy chậm, ít quá thì không đủ, trong code mình có đoạn code xử lý mảng kết quả khai báo thiếu dòng
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2