从列的单元格复制到特定单元格
Copy from a cell of a column to a specific cell
我正在为 Excel 创建代码以将前一列中的单元格内容复制到下一个单元格。我要复制其内容的单元格是绿色的。但是我需要搜索整个工作簿和所有工作 sheet 中的所有内容,因为每个绿色单元格可以在不同的列中。我的代码是:
Dim wb As Workbook
Dim sht As Worksheet
frow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
fcol = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Column
Cells.UnMerge
Set wb = ActiveWorkbook
For Each sht In wb.Sheets
For ncol = 1 To fcol
For nrow = 1 To frow
If Cells(nrow, ncol).Interior.Color = RGB(0, 128, 0) Then
Cells(nrow, ncol - 1).Copy
Cells(nrow, ncol).Select
ActiveSheet.Paste
Cells(nrow, ncol).Interior.Color = RGB(0, 128, 0)
End If
Next
Next
但问题是,在某些 sheet 中,带有绿色单元格的列是空的,代码只获取所有包含内容的列(因此 fcol 是 totalColumnstoProcess-1)因此它不会复制我想要的单元格内容。
总结:我想转到工作簿中的所有工作sheet,检测哪里有绿色单元格并将该内容复制到下一列,同一行。
有没有其他方法可以处理sheet中的所有内容?
知道为什么我的代码不起作用吗?
除非我遗漏了什么,否则这不可行吗?
dim r as range
dim ws as worksheet
for each ws in worksheets
for each r in ws.usedrange
if r.Interior.Color = RGB(0, 128, 0) Then
r = r.offset(0,-1)
end if
next r
next ws
我认为您的代码可能存在一些问题。
- 您需要在 sheet 乘 sheet 的基础上定义您作品sheet的搜索区域,因此它需要在您的循环中。
UsedRange
通常要避免,因为它会选择格式和内容,但在您的情况下它会工作得很好。您的活动区域定义仅提取内容。
下面的代码应该有所帮助,但如果有两个相邻的绿色单元格,则需要多加考虑。
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Const GREEN As Long = 32768 'RGB(0, 128, 0)
For Each ws In ThisWorkbook.Worksheets
' Define the range we want to interrogate
Set rng = ws.UsedRange
' Check we have some cells to work with.
If rng.Cells.Count > 1 Or rng.Cells(1, 1).Interior.Color = GREEN Then
For Each cell In rng
'Find a green cell, making sure it isn't in Column "A"
If cell.Column > 1 And cell.Interior.Color = GREEN Then
cell.Value = cell.Offset(, -1).Value2
'if you want to delete the old cell's value then uncomment the next line
cell.Offset(, -1).Value = vbNullString
End If
Next
End If
Next
我正在为 Excel 创建代码以将前一列中的单元格内容复制到下一个单元格。我要复制其内容的单元格是绿色的。但是我需要搜索整个工作簿和所有工作 sheet 中的所有内容,因为每个绿色单元格可以在不同的列中。我的代码是:
Dim wb As Workbook
Dim sht As Worksheet
frow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
fcol = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Column
Cells.UnMerge
Set wb = ActiveWorkbook
For Each sht In wb.Sheets
For ncol = 1 To fcol
For nrow = 1 To frow
If Cells(nrow, ncol).Interior.Color = RGB(0, 128, 0) Then
Cells(nrow, ncol - 1).Copy
Cells(nrow, ncol).Select
ActiveSheet.Paste
Cells(nrow, ncol).Interior.Color = RGB(0, 128, 0)
End If
Next
Next
但问题是,在某些 sheet 中,带有绿色单元格的列是空的,代码只获取所有包含内容的列(因此 fcol 是 totalColumnstoProcess-1)因此它不会复制我想要的单元格内容。
总结:我想转到工作簿中的所有工作sheet,检测哪里有绿色单元格并将该内容复制到下一列,同一行。
有没有其他方法可以处理sheet中的所有内容? 知道为什么我的代码不起作用吗?
除非我遗漏了什么,否则这不可行吗?
dim r as range
dim ws as worksheet
for each ws in worksheets
for each r in ws.usedrange
if r.Interior.Color = RGB(0, 128, 0) Then
r = r.offset(0,-1)
end if
next r
next ws
我认为您的代码可能存在一些问题。
- 您需要在 sheet 乘 sheet 的基础上定义您作品sheet的搜索区域,因此它需要在您的循环中。
UsedRange
通常要避免,因为它会选择格式和内容,但在您的情况下它会工作得很好。您的活动区域定义仅提取内容。
下面的代码应该有所帮助,但如果有两个相邻的绿色单元格,则需要多加考虑。
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Const GREEN As Long = 32768 'RGB(0, 128, 0)
For Each ws In ThisWorkbook.Worksheets
' Define the range we want to interrogate
Set rng = ws.UsedRange
' Check we have some cells to work with.
If rng.Cells.Count > 1 Or rng.Cells(1, 1).Interior.Color = GREEN Then
For Each cell In rng
'Find a green cell, making sure it isn't in Column "A"
If cell.Column > 1 And cell.Interior.Color = GREEN Then
cell.Value = cell.Offset(, -1).Value2
'if you want to delete the old cell's value then uncomment the next line
cell.Offset(, -1).Value = vbNullString
End If
Next
End If
Next