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