現有一個實際需求，請教各方高手
excel表格中 要用到的資料有兩列 分別在A列及M列 A列與M列一一對應
例子：
若M1~M10>3，0<M11~M20<3，M21~M30>3，M31~M40<0，0<M41~M50<3。。。。。
注意是每個值均滿足特定條件，比如M1、M2、M3.......M10 這10個數全部滿足>3
則需要輸出如下資料：
A1，A10，M1~M10的平均值
A10，A20，M11~M20的平均值
A20，A30，M21~M30的平均值
A30，A40，M31~M40的平均值
A40，A50，M41~M50的平均值
。
。
。
簡單來說就是把M列的資料按照小于0、大于0且小于3，大于3分類、篩選，然后輸出每類對應A列的首尾資料，以及M列的平均值
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
我自己編了一個代碼 但是存在如下問題，請各位高手不吝賜教
1.無法統計出最后一種分類，譬如例子中，若資料到第50行就結束了，那么“A40，A50，M41~M50的平均值”這組資料無法輸出
2.無法篩選出<0的情況，以至于把<0的這一類給統計到大于0且小于3的這一類了
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
附代碼：
Sub fenleishaixuan()
Dim n As Integer
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim y As Single
Dim z As Single
Dim aver() As Single
Dim k1() As Long
Dim k2() As Long
n = [m65536].End(xlUp).Row 'M列最后一行非空單元格行號
ReDim k1(0 To n)
ReDim k2(0 To n)
ReDim aver(0 To n)
i = 1
j = 0
x = 1
y = Cells(1, "m")
k1(j) = Cells(i, "a")
Do While i <= n '如果當前單元格行號不大于最后一行則執行回圈
If Cells(i, "m") >= 3 Then '單元格如果大于3
j = j + 1
If j < 2 Then
k1(j - 1) = Cells(1, "a")
Else
k1(j - 1) = k2(j - 2)
End If
k2(j - 1) = Cells(i, "a")
z = 1
y = Cells(x, "m")
Do While x < i
y = y + Cells(x + 1, "m")
x = x + 1
z = z + 1
Loop
aver(j - 1) = y / z
i = i + 1
j = j + 1
If Cells(i, "m") < 3 Then '單元格如果小于3
k1(j - 1) = Cells(i - 1, "a")
k2(j - 1) = Cells(i - 1, "a")
aver(j - 1) = Cells(i, "m")
Else
y = Cells(i - 1, "m")
Do While i <= n '如果當前單元格行號不大于最后一行則執行回圈
If Cells(i, "m") < 3 Then '單元格如果小于3
k1(j - 1) = k2(j - 2)
k2(j - 1) = Cells(i - 1, "a")
z = 1
Do While x < i - 1
y = y + Cells(x + 1, "m")
x = x + 1
z = z + 1
Loop
aver(j - 1) = y / z
'i = i + 1
Exit Do
End If
i = i + 1
Loop
End If
End If
i = i + 1 '行號+1，準備下一個回圈
Loop ‘資料輸出
Dim wk As Worksheet
Dim k As String
k = InputBox("Please input name")
Set wk = Worksheets.Add
wk.Name = k
Range("a1:a100") = Application.Transpose(k1)
Range("b1:b100") = Application.Transpose(k2)
Range("c1:c100") = Application.Transpose(aver)
End Sub
uj5u.com熱心網友回復：
應該是很簡單的問題。我相信你會做出來。暫時沒有時間去幫你。幫頂一下。uj5u.com熱心網友回復：
在Excel 2003中開始記錄宏，手動完成所需功能，結束記錄宏，按Alt+F11鍵，查看剛才記錄的宏對應的VBA代碼。uj5u.com熱心網友回復：
1、若M1~M10>3，0<M11~M20<3，M21~M30>3，M31~M40<0，0<M41~M50<3。。。。。2、簡單來說就是把M列的資料按照小于0、大于0且小于3，大于3分類、篩選....
這2個放一起，就不知道怎么辦了......
uj5u.com熱心網友回復：
嘗試弄了一個，自測好用，平均值顯示在第一個值的旁邊，起個拋磚引玉的作用吧
Sub getNumbers()
Dim getRows
getRows = Range("M65536").End(xlUp).Row
Dim switchChange
switchChange = 0
Range("M1").Activate
Dim valueTxt
Dim startCell, endCell
Dim firstNumber, lastNumber
Dim tempNumber
tempNumber = 0
Dim numberCount
For i = 1 To getRows
valueTxt = values(ActiveCell.Text)
If i > 1 Then
If switchChange <> valueTxt Then
endCell = ActiveCell.Address
Range("A" & (ActiveCell.Row - 1)).Activate
ActiveCell = lastNumber
Range("A" & startCell).Activate
ActiveCell = firstNumber
ActiveCell.Offset(0, 1).Activate
ActiveCell = tempNumber / numberCount
Range(endCell).Activate
firstNumber = ActiveCell.Text
startCell = ActiveCell.Row
tempNumber = CLng(ActiveCell.Text)
numberCount = 1
switchChange = valueTxt
Else
numberCount = numberCount + 1
tempNumber = tempNumber + CLng(ActiveCell.Text)
lastNumber = ActiveCell.Text
End If
Else
switchChange = valueTxt
startCell = ActiveCell.Row
firstNumber = ActiveCell.Text
tempNumber = CLng(ActiveCell.Text)
numberCount = 1
End If
ActiveCell.Offset(1, 0).Activate
Next i
Range("A" & (ActiveCell.Row - 1)).Activate
ActiveCell = lastNumber
Range("A" & startCell).Activate
ActiveCell = firstNumber
ActiveCell.Offset(0, 1).Activate
ActiveCell = tempNumber / numberCount
End Sub
Function values(value)
If value > 0 And value < 3 Then
values = 1
ElseIf value > 3 Then
values = 2
End If
End Function
uj5u.com熱心網友回復：
哦，對了，判斷的程序里我只寫了 0<M<3和 M>3的情況，如果需要請自行添加轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/82844.html
標籤：VBA