Excel VBA:特定の列の空白セルにテキストを追加してから、次の空白セルにループしてテキストを追加するにはどうすればよいですか?
Aug 22 2020
列Aの空白のセルにテキストを追加するマクロが必要です。マクロはテキストのあるセルをスキップする必要があります。マクロは、データセットの最後でループを停止する必要があります。
If Elseステートメントを使用しようとしていますが、間違った方向に進んでいると思います。私の現在の機能していないコードは以下のとおりです。どうもありがとうございました-私はまだVBAに不慣れです
Sub ElseIfi()
For i = 2 To 100
If Worksheets("RawPayrollDump").Cells(2, 1).Value = "" Then
Worksheets("RawPayrollDump").Cells(2, 1).Value = "Administration"
Else if(not(worksheets("RawPayrollDump").cells(2,1).value="")) then 'go to next cell
End If
Next
End Sub
回答
2 Mike67 Aug 22 2020 at 21:42
データの最後の行を見つけるには、End(xlUp)
関数を使用します。
このコードを試してください。列Aのすべての空のセルを管理に置き換えます。
Sub ElseIfi()
Set ws = Worksheets("RawPayrollDump")
lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row ' last data row
For i = 2 To lastrow ' all rows until last data row
If ws.Cells(i, 1).Value = "" Then ' column A, check if blank
ws.Cells(i, 1).Value = "Administration" ' set text
End If
Next
End Sub
1 Variatus Aug 23 2020 at 00:33
ループする必要はありません。このコードを試してください。
Sub FillBlanks()
Dim Rng As Range
With Worksheets("RawPayrollDump")
Set Rng = Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
End With
On Error Resume Next
Set Rng = Rng.SpecialCells(xlCellTypeBlanks)
If Err Then
MsgBox "There are no blank cells" & vbCr & _
"in the specified range.", _
vbInformation, "Range " & Rng.Address(0, 0)
Else
Rng.Value = "Administration"
End If
End Sub
VBasic2008 Aug 23 2020 at 12:02
ブランクを交換するfeat。CurrentRegion
Range.CurrentRegion
- OPが「...データセットの最後でループを停止する」と要求したので、私はこの
CurrentRegion
バージョンを作成しました。 - 私が理解しているように、データセットの終わりは、列のデータを含む最後のセルの下に空白のセルが存在できないことを意味するものではありません
A
。 - 1番目のサブを使用して2番目のメインサブ(
replaceBlanks
)をテストします。 - 必要に応じて、ワークブック(1番目のサブ)を含む定数を調整します。
Criteria
文字列だけでなく他のデータ型を許可するためにVariantとして宣言されています。
コード
Option Explicit
Sub testReplaceBlanks()
Const wsName As String = "RawPayrollDump"
Const FirstCellAddress As String = "A2"
Const Criteria As Variant = "Administration"
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
Call replaceBlanks(ws, FirstCellAddress, Criteria)
End Sub
Sub replaceBlanks(Sheet As Worksheet, _
FirstCellAddress As String, _
Criteria As Variant)
' Define column range.
Dim ColumnRange As Range
Set ColumnRange = Intersect(Sheet.Range(FirstCellAddress).CurrentRegion, _
Sheet.Columns(Sheet.Range(FirstCellAddress) _
.Column))
' To remove the possibly included cells above the first cell:
Set ColumnRange = Sheet.Range(Range(FirstCellAddress), _
ColumnRange.Cells(ColumnRange.Cells.Count))
' Note that you can also use the addresses instead of the cell range
' objects in the previous line...
'Set ColumnRange = sheet.Range(FirstCellAddress, _
ColumnRange.Cells(ColumnRange.Cells.Count) _
.Address)
' or a mixture of them.
' Write values from column range to array.
Dim Data As Variant
If ColumnRange.Cells.Count > 1 Then
Data = ColumnRange.Value
Else
ReDim Data(1 To 1, 1 To 1): Data(1, 1) = ColumnRange.Value
End If
' Modify array.
Dim i As Long, k As Long
For i = 1 To UBound(Data)
If IsEmpty(Data(i, 1)) Then Data(i, 1) = Criteria: k = k + 1
Next i
' Write modified array to column range.
' The following line is used when only the first cell is known...
'Sheet.Range(FirstCellAddress).Resize(UBound(Data)).Value = Data
' ...but since the range is known and is the same size as the array,
' the following will do:
ColumnRange.Value = Data
' Inform user.
If k > 0 Then GoSub Success Else GoSub Fail
Exit Sub
' Subroutines
Success:
MsgBox "Wrote '" & Criteria & "' to " & k & " previously " _
& "empty cell(s) in range '" & ColumnRange.Address & "'.", _
vbInformation, "Success"
Return
Fail:
MsgBox "No empty cells in range '" & ColumnRange.Address & "'.", _
vbExclamation, "Nothing Written"
Return
End Sub