＞＞26 for next で調べてみてくれや。 for j = 1 to 3 Cells(1, 3+ｊ).AutoFill Range(Cells(1, 3+ｊ), Cells(50, 3+ｊ)), xlFillSeries next こんな感じでいいんじゃないかな？ 半年ぶりＶＢＡだから少し不安。素人です。
1回しか使ってない変数がいくつもあるけど、まとめると読みにくくなるし とりあえず空行を詰めるだけならこんな感じでいける Sub Macro1() With ActiveSheet.UsedRange r1 = .Row c1 = .Column r2 = r1 + .Columns.Count - 1 c2 = c1 + .Rows.Count - 1 End With
With Application.WorksheetFunction For i = r2 - 1 To r1 Step -1 If .CountA(Rows(i)) = 0 Then Rows(i).Delete Next For i = c2 - 1 To c1 Step -1 If .CountA(Columns(i)) = 0 Then Columns(i).Delete Next End With End Sub
>>48 クリップボードから非表示の行は飛ばして張りつける Set dst = Application.Selection Set dataobj = New DataObject dataobj.GetFromClipboard clipstr = dataobj.GetText(1) row = 0 For Each clipline In Split(clipstr, vbCrLf) Do While dst.Offset(row, 0).Rows(1).Hidden = True row = row + 1 Loop col = 0 For Each s In Split(clipline, vbTab) dst.Offset(row, col).Value = s col = col + 1 Next row = row + 1 Next いろいろチェックしないとダメだがまあこんな感じでどうだ
59 ：
よく考えたら、大して行が長くなるわけでもないのでまとめた Sub Macro2() With ActiveSheet.UsedRange For i = .Row + .Rows.Count - 2 To .Row Step -1 If Application.WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).Delete Next For i = .Column + .Columns.Count - w To .Column Step -1 If Application.WorksheetFunction.CountA(Columns(i)) = 0 Then Columns(i).Delete Next End With End Sub
60 ：
またタイプミスしてるよ… orz Sub Macro2() With ActiveSheet.UsedRange For i = .Row + .Rows.Count - 2 To .Row Step -1 If Application.WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).Delete Next For i = .Column + .Columns.Count - 2 To .Column Step -1 If Application.WorksheetFunction.CountA(Columns(i)) = 0 Then Columns(i).Delete Next End With End Sub
VBA初心者です。基本的なことで申し訳ないのですが、質問させてください。 今8枚目以降のシートを新規ブックに移動したく、選択する所まで以下のコードを作りました。 Dim i As Integer If ActiveWorkbook.Worksheets.Count < 8 Then Exit Sub For i = 8 To ActiveWorkbook.Worksheets.Count Worksheets(i).Select (False) Next i この後、選択移動をしたシートを移動するのですが、 色んなサイトを覗いては見たものの「Sheets(Array(1, 2, 3)).Move」等、 シート名やインデックス番号を指定するものばかりで、中々先に進めません。 選択しているシートを移動する、又は連続しているシートを移動する何か良いやり方はないでしょうか。
Sub TrimEndCrLf(ByVal filepath As String) Dim stream As ADODB.stream Set stream = New ADODB.stream stream.Type = ADODB.adTypeBinary Call stream.Open Call stream.LoadFromFile(filepath) If stream.Size >= 1 Then Dim b As Byte stream.Position = stream.Size - 1 b = stream.Read(1)(0) If b = 13 Or b = 10 Then If b = 13 Then stream.Position = stream.Position - 1 ElseIf b = 10 Then If stream.Size >= 2 Then stream.Position = stream.Position - 2 b = stream.Read(1)(0) If b = 13 Then stream.Position = stream.Position - 1 End If Else stream.Position = stream.Position - 1 End If End If Call stream.SetEOS Call stream.SaveToFile(filepath, ADODB.adSaveCreateOverWrite) End If End If Call stream.Close End Sub
82 ：
Sub TrimEndCrLf(ByVal TextPath As String) Const NlCode = vbNewLine ' 改行の種類を設定 Dim Fso As New FileSystemObject Dim TextSrc As String Dim Lines() As String TextSrc = Fso.OpenTextFile(TextPath, ForReading).ReadAll Lines = Split(TextSrc, NlCode) If Lines(UBound(Lines)) = "" Then ReDim Preserve Lines(UBound(Lines) - 1) Fso.CreateTextFile(TextPath, True).Write Join(Lines, NlCode) End Sub
83 ：
空ファイルもあり得るなら If FileLen(TextPath) = 0 Then Exit Sub を追加 まあ With Fso.OpenTextFile(TextPath, ForReading) If .AtEndOfLine Then Exit Sub TextSrc = .ReadAll End With でもいいけど
