ねこになりたい

おふとんと朝の別れをするのが辛い人向けです。正論で殴らず見守ってあげてください。

Excelで列を追加 or 編集するテスト

めちゃくちゃ適当に作ったやつ、後で直さなきゃ。

f:id:Arpino:20200524114831p:plain

 

Sub Macro1()
'
' Macro1 Macro
'
Dim intInsertNo As String ' 挿入位置
Dim intSum As Integer ' 挿入したいソート連番の合計数
Dim intSearchStartNo As Integer ' 検索したい始点
Dim intSearchEndNo As Integer ' 検索したい終点
Dim rngSearchRange As Range ' 検索範囲
Dim rngSearchResultNo As Range ' 検索結果
Dim intSearchResultNo As Integer ' 検索結果(Integer)
Dim rngSearch As Range ' 検索用のRange
Dim intEndRow As Integer ' 行の終点
Dim str As String, i As Integer, cnt As Integer

' マップ用
Dim sort As Object
Dim Keys() As Variant

' 編集カラム
Dim currentUpdateColumn As Integer

' 次のカラム
Dim nextColumn As Integer


Set sort = CreateObject("Scripting.Dictionary")
sort.Add "セクション1", "a"
sort.Add "セクション2", "b"
sort.Add "セクション3", "c"
Keys = sort.Keys

If optInsert = True Then
' 追加
For i = 0 To sort.Count - 1
str = str & Keys(i) & " : " & sort.Item(Keys(i)) & vbCrLf

' 編集カラム
currentUpdateColumn = Range(startCompileInsertColumn & startCompileInsertRow).Column - 1

If Cells(startCompileInsertRow, currentUpdateColumn).Value = Keys(i) Then

' 始点を検索
intEndRow = Range(searchColumn + startRow).End(xlDown).Row
Set rngSearch = Range(searchColumn + startRow & ":" & searchColumn & intEndRow)
intSearchStartNo = rngSearch.Find(What:=sort.Item(Keys(i))).Row

'合計数を検索
intSum = WorksheetFunction.CountIf(Range(searchColumn + startCntRow & ":" & searchColumn & intEndRow), sort.Item(Keys(i)) & "*")

'終点を検索
intSearchEndNo = intSearchStartNo + intSum - 1

' 挿入位置を確定
intInsertNo = intSearchEndNo + 1

If intInsertNo <> "" Then
Rows(intInsertNo).Insert
' 番号
Range(searchColumn & intInsertNo).Value = sort.Item(Keys(i)) & intSum + 1
Range(searchColumn & intInsertNo).Font.Color = RGB(255, 0, 0)

For m = 1 To cntColumnCompileNo
' 次のカラムへ
nextColumn = nextColumn + 1

' 編集するカラムを次に移動する
currentUpdateColumn = Range(startCompileInsertColumn & startCompileInsertRow).Column + nextColumn

' 値を詰める
Range(searchColumn & intInsertNo).Offset(0, nextColumn).Value = Cells(startCompileInsertRow, currentUpdateColumn).Value
Range(searchColumn & intInsertNo).Offset(0, nextColumn).Font.Color = RGB(255, 0, 0)
Next
End If
End If
Next i
Else
' 更新
For i = 0 To sort.Count - 1
str = str & Keys(i) & " : " & sort.Item(Keys(i)) & vbCrLf

' 編集カラム
currentUpdateColumn = Range(startCompileUpdateColumn & startCompileUpdateRow).Column - 1

If Cells(startCompileUpdateRow, currentUpdateColumn).Value = Keys(i) Then
intInsertNo = Range(startCompileUpdateColumn & startCompileUpdateRow).Value
End If
Next i

' 始点を検索
intEndRow = Range(searchColumn + startRow).End(xlDown).Row
Set rngSearch = Range(searchColumn + startRow & ":" & searchColumn & intEndRow)
intSearchStartNo = rngSearch.Find(What:=Left(Range(startCompileUpdateColumn & startCompileUpdateRow).Value, 1)).Row

'合計数を検索
intSum = WorksheetFunction.CountIf(Range(searchColumn + startRow & ":" & searchColumn & intEndRow), "a*")

'終点を検索
intSearchEndNo = intSearchStartNo + intSum - 1

' 更新位置を確定
intInsertNo = CutLeft(intInsertNo, 1)

'検索範囲を決める
Set rngSearchRange = Range(searchColumn & intSearchStartNo & ":" & searchColumn & intSearchEndNo)

'何列目かを求める
Set rngSearchResultNo = rngSearchRange.Find(What:=Range("D2"))

If Not rngSearchResultNo Is Nothing Then
' 数値に変換
intSearchResultNo = rngSearchResultNo.Row

For i = 1 To cntColumnCompileNo
' 次のカラムへ
nextColumn = nextColumn + 1

' 編集するカラムを次に移動する
currentUpdateColumn = Range(startCompileUpdateColumn & startCompileUpdateRow).Column + nextColumn

' 値を変更
Range(searchColumn & intSearchResultNo).Offset(0, nextColumn).Value = Cells(startCompileUpdateRow, currentUpdateColumn).Value
Range(searchColumn & intSearchResultNo).Offset(0, nextColumn).Font.Color = RGB(0, 0, 255)
Next i
End If
End If

End Sub

 

Function CutLeft(s, i As Long) As String
Dim iLen As Long '// 文字列長

'// 文字列ではない場合
If VarType(s) <> vbString Then
Exit Function
End If

iLen = Len(s)

'// 文字列長より指定文字数が大きい場合
If iLen < i Then
Exit Function
End If

'// 指定文字数を削除して返す
CutLeft = Right(s, iLen - i)
End Function

 

ラジオボタン

Global optInsert As Boolean
Global optUpdate As Boolean

Sub ボタン2_Click()
optInsert = True
optUpdate = False
End Sub
Sub ボタン3_Click()
optUpdate = True
optInsert = False
End Sub

 

※設定用

' 検索する列
Global Const searchColumn = "A"

' 検索する列のキャプション列
Global Const startRow = "3"

' カウント開始列
Global Const startCntRow = "4"

' 行数
Global Const cntColumn = 2

' INSERT(編集用)セル
Global Const startCompileInsertColumn = "D"
Global Const startCompileInsertRow = "1"

' UPDATE(編集用)セル
Global Const startCompileUpdateColumn = "D"
Global Const startCompileUpdateRow = "2"

' 編集用カラム総数
Global Const cntColumnCompileNo = 3

行き当たりばったりの、わがまま追体験ゴッコ

お題「#おうち時間

 

部屋の掃除をしていたら、びっしりと書かれた学生時代の手帳。

そして、デジタルカメラに積もり積もった写真が出てきて、気が付いたら8年前から遡って撮った写真と駄文をブログに書いていた。

 

事の発端は2012年2月の手帳である。

なんだか細々と書いてある。細かいことを色々と考えていたんだろう。

事前に色々と考えないと行動に移せなかったのだ。

f:id:Arpino:20200502203604j:plain

 

 

なんでもっとはやく投稿しなかったんだろう。

こんな無機質な文章じゃなくて、もっと生々しい文章が書けただろうに。

 

思い返すのが、なんで今なんだろう。

優しい顔をした虚無感だけが付きまとうが、それでも追体験ゴッコがしたくなった。

 

そして、意を決して画像をアップロード。

当時の手帳を見ながらキーボードを叩きはじめる。

 

賽は投げられた。もはや誰にも止められない。

arpino.hatenadiary.com

arpino.hatenadiary.com

arpino.hatenadiary.com

↓おまけ

arpino.hatenadiary.com

ひたすら写真をブログに投下しまくる。

すでに今月のファイル利用料が70%になっているが、他人事みたいな顔だ。

 

本当は思いつき次第補足していきたいが、この手の類は後から読み返すと布団に駆け込みたくなること請け合いなので、酒に酔った勢いで流れるように書いて放置してしまうが得策である。

もちろん、読む側からすると文章構成がガタガタで到底読めたものじゃないが・・・。

 

どうせテレビなんてつけても同じ話題ばかり。

仕事の流れだって同じ同じ繰り返し。

油断してると誰もが似たような悩みに突き当たってしまう。

くたびれ損の骨折り儲け。

 

だけど、それでも必死にしがみ付きたいのが人生ってもんじゃないか。

少しぐらい楽しみながら発狂したって、きっと罰は当たるまい。

Value

概要

 
Rangeオブジェクト.Value
セル範囲を取得・設定する。

サンプル

B2セルの値を取得し、B3セルに値を設定する。

f:id:Arpino:20200419164220p:plain

 

Debug.Print Range("B2").Value
Range("B3").Value = "(´・ω・`)焼肉食いてえ"

実行結果

f:id:Arpino:20200419164253p:plain

f:id:Arpino:20200419164305p:plain





 

Resize

概要

 
Rangeオブジェクト.Resize(行数, 列数)
参照するセル範囲を再取得する。

サンプル

C2セルを基準に、タイトルを除いて表のセルを選択する。

f:id:Arpino:20200419162121p:plain

' 表全体をOffsetで1行ずらす → 一番下をずらした分だけResizeで1行上にあげる
With Range("B3").CurrentRegion 
.Offset(1).Resize(.Rows.Count - 1).Select
End With

実行結果

f:id:Arpino:20200419163113p:plain





 

CurrentRegion

概要

 
Rangeオブジェクト.CurrentRegion
セル同士が隣接している表全体を選択する。

サンプル

B3セルを基準に、空白以外の隣接するセルを選択する。

f:id:Arpino:20200419160636p:plain

Range("C3").CurrentRegion.Select

実行結果

f:id:Arpino:20200419161128p:plain



 

Offset

 

概要

 
Offset(行の移動数, 列の移動数)
指定したセルを基準に、指定した位置を参照する。
行の移動数は正の数が下で、負の数は上。
列は正の数が右で、負の数は左。

サンプル

B3セルから数えて最後のセルの次のセル(B11セル)を編集する。

f:id:Arpino:20200419155612p:plain

Range("B3").End(xlDown).Offset(1).Select
ActiveCell.Value = "(´・ω・)σ)・ω・)"

実行結果

f:id:Arpino:20200419155809p:plain