从列的单元格复制到特定单元格

时间:2015-09-22 09:07:37

标签: excel vba excel-vba cell

我正在创建Excel代码,将前一列中单元格的内容复制到下一个单元格。我要复制其内容的单元格为绿色。但我需要搜索整个工作簿和所有工作表中的所有内容,因为每个绿色单元格可以位于不同的列中。我的代码是:

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

但问题是在某些工作表中,带有绿色单元格的列是空的,代码只获取包含内容的所有列(因此fcol是totalColumnstoProcess-1)因此它不会将内容复制到我的单元格想要它。

总结:我想转到工作簿中的所有工作表,检测绿色单元格的位置,并将该内容复制到下一列,同一行。

有没有其他方法可以处理表格中的所有内容? 知道为什么我的代码不起作用吗?

2 个答案:

答案 0 :(得分:1)

除非我遗漏了什么,否则不应该这样做吗?

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

答案 1 :(得分:1)

我认为您的代码可能存在一些问题。

  1. 您需要逐页定义工作表的搜索区域,因此需要在您的循环中。
  2. UsedRange通常是要避免的,因为它会选择格式和内容,但在你的情况下,它会很好地工作。您的活动区域定义仅选择内容。
  3. 下面的代码应该有所帮助,但如果有两个相邻的绿色单元,则需要更多考虑。

        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
    
相关问题