excel - 仅复制内部索引颜色 = 6 的单元格

Question

我需要复制包含内部颜色 = 6 (vbyellow) 的列的单元格，并将它们粘贴到新工作表中，并将这个新叶子以txt格式保存在c:\code.txt中。谁能帮我这个？

Answer 1

抱歉第一次发帖。我还不确定这个网站上的格式是如何工作的。您需要测试以下内容。添加错误处理并相应地重构。您还需要在工作表的某处定义范围 columnRng，实际上您可以将其更改为 inputRange，因为它不必是列。作为一个侧面声明，保存以某种颜色突出显示的值对我来说听起来有点像一罐蠕虫，但你比我更了解你的问题域。

Option Explicit


Sub SaveValues()

Const colorLongVal As Long = 6
Dim rng As Range
Dim wks As Worksheet
Dim varToWriteToSht As Variant
Dim txtFileFullPath As String

txtFileFullPath = "f:\test.txt"
Set rng = Range("columnRng")
varToWriteToSht = GetValsByColour(rng, colorLongVal)

Set wks = WriteValsToNewSht(varToWriteToSht)
SaveWorkSheetAsTxtFile wks, txtFileFullPath

End Sub

Sub SaveWorkSheetAsTxtFile(ws As Worksheet, txtFileFullPath As String)

ws.SaveAs txtFileFullPath, xlTextMSDOS

End Sub


'Accepts 2D variant array. Creates a new worksheet and writes to the top right hand corner of that sheet

Public Function WriteValsToNewSht(varToWriteToSht As Variant) As Worksheet

Dim wks As Worksheet
Dim resultRowsCnt As Long
Dim resultColsCnt As Long
Dim rngToWriteTo As Range

Set wks = ThisWorkbook.Worksheets.Add()
resultRowsCnt = UBound(varToWriteToSht, 1)
resultColsCnt = UBound(varToWriteToSht, 2)

If resultRowsCnt = 0 Then resultRowsCnt = 1
If resultColsCnt = 0 Then resultColsCnt = 1
Set rngToWriteTo = wks.Range("A1").Resize(resultRowsCnt, resultColsCnt)
rngToWriteTo.Value = varToWriteToSht

Set WriteValsToNewSht = wks

End Function

'Returns a variant array of the values that is writable directly to a range
Function GetValsByColour(rng As Range, interiorColourVal As Long) As Variant

Dim resultVar As Variant
Dim resultCol As Collection
Dim i As Long
Dim j As Long

Dim val As Variant
Dim cell As Range

Set resultCol = New Collection

'You might want to not use a collection and redim the result array yourself
For Each cell In rng
    If cell.Interior.ColorIndex = interiorColourVal Then
        resultCol.Add cell.Value
    End If
Next cell

ReDim resultVar(1 To resultCol.Count, 1 To 1)
For i = 1 To resultCol.Count
    resultVar(j + 1, 1) = resultCol.Item(i)
    j = j + 1
Next i

GetValsByColour = resultVar

End Function

Answer 2

我会使用过滤器或循环通过单元格。

即使这不完整，它应该让你开始......

  Sub Macro2()
      Columns("A:A").AutoFilter Field:=1, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
      Columns("A:A").Copy
      Workbooks.Add
      Selection.PasteSpecial Paste:=xlPasteValues
      ActiveWorkbook.SaveAs Filename:="C:\Code.txt", FileFormat:=xlTextMSDOS, CreateBackup:=False

  End Sub