每行和每列黄色区域的和

杨杨1991315 · 发表于 2020-1-2 18:22

本帖最后由杨杨1991315 于 2020-1-2 18:28 编辑

每行和每列黄色区域的和

shenjianrong163 · 发表于 2020-2-15 11:10

Sub test()
Dim i, j, sum
With Sheets("sheet1")
.Range("H3:H" & .Cells(.Rows.Count, 3).End(xlUp).Row).ClearContents
For i = 3 To .Cells(.Rows.Count, 3).End(xlUp).Row
sum = 0
For j = 3 To .Cells(3, .Columns.Count).End(xlToLeft).Column
If .Cells(i, j).Interior.ColorIndex = 6 Then
sum = sum + .Cells(i, j).Value
End If
Next
.Cells(i, 8) = sum
Next
End With
End Sub

复制代码

shenjianrong163 · 发表于 2020-2-15 11:12

请参考附件：

每行黄色区域的和.rar (12.02 KB, 下载次数: 5)

shenjianrong163 · 发表于 2020-2-15 11:13

Sub test()
Dim i, j, sum
With Sheets("sheet1")
.Range("H3:H" & .Cells(.Rows.Count, 3).End(xlUp).Row).ClearContents
For i = 3 To .Cells(.Rows.Count, 3).End(xlUp).Row
sum = 0
For j = 3 To .Cells(3, .Columns.Count).End(xlToLeft).Column
If .Cells(i, j).Interior.ColorIndex = 6 Then
sum = sum + .Cells(i, j).Value
End If
Next
.Cells(i, 8) = sum
Next
End With
End Sub

复制代码

NadrsSaber · 发表于 2020-2-15 11:26

Option Explicit
Sub test()
Dim rr% '行号
Dim cc% '列号
Dim sum& '求和
For rr = 3 To 8
For cc = 3 To 6
If Sheet1.Cells(rr, cc).Interior.Color = 65535 Then
sum = sum + Sheet1.Cells(rr, cc).Value
End If
Next
Sheet1.Cells(rr, 8) = sum
sum = 0
Next
End Sub

复制代码

yjh_27 · 发表于 2020-2-15 19:50

自定义函数，按行、按列、按区域任意。

环境所迫 · 发表于 2020-2-15 20:21

shenjianrong163 发表于 2020-2-15 11:13

您好，如何只要一个汇总数呢？

shenjianrong163 · 发表于 2020-2-16 11:02

环境所迫发表于 2020-2-15 20:21
您好，如何只要一个汇总数呢？

Sub test()
Dim rng As Range
For Each rng In ActiveSheet.UsedRange
If rng.Interior.ColorIndex = 6 Then
m = m + 1
End If
Next
Sheets("sheet1"). Cells(3,8) = m
End Sub

		自动登录	找回密码
密码			免费注册

[求助] 每行和每列黄色区域的和

评分