「Excel」タグアーカイブ

エクセルで電子納品を楽にする

ソフトを使わずに電子納品のファイルを用意するのはなかなか手間がかかるので、
最終的なファイルを集める作業とかファイル名称を変えつつコピーする部分をエクセルで集計してやる方法を思いついた。

そのほかにも使えるケースがあるかもしれないので、
アップしてみる。

ファイル収集(電子納品などにどうぞ)
ちなみに、黄色い背景にしている範囲をダブルクリックすると、そのセル以下に選んだファイルパスが登録できます。

マクロ部分。(雑ですみません)

‘—————————————————————
‘2015/3/29
‘作成環境: Excel2010

‘known bugs: まだ解らない. 😉

‘—————————————————————

Private Sub StartFileCopy()
On Error GoTo ErrorHandler

Set fs = CreateObject(“Scripting.FileSystemObject”)
Dim gyo As Integer
Dim targetDir As String

If Range(“B” & CStr(7)).Value = “” Then
MsgBox “ファイル登録が一つも無い…”, , “ちょっとまって!”
Exit Sub
End If

targetDir = Range(“C3”).Value

Do
If Range(“B” & CStr(gyo + 7)).Value = “” Then Exit Do ‘指定ファイルが書いてないとき

‘登録したPATH
‘MsgBox Range(“B” & CStr(gyo + 7)).Value
‘フォルダー名取得
‘MsgBox fs.GetParentFolderName(Range(“B” & CStr(gyo + 7)).Value)
‘ファイル名取得
‘MsgBox fs.GetFileName(Range(“B” & CStr(gyo + 7)).Value)
‘拡張子取得
‘MsgBox fs.GetExtensionName(Range(“B” & CStr(gyo + 7)).Value)

If Range(“c” & CStr(gyo + 7)).Value = “” Then
‘リネーム名指定なしの場合はファイル名そのままでコピー
fs.CopyFile Range(“B” & CStr(gyo + 7)).Value, _
targetDir & “\” & fs.GetFileName(Range(“B” & CStr(gyo + 7)).Value), False
Else
‘リネーム名指の指定があれば、コピー
fs.CopyFile Range(“B” & CStr(gyo + 7)).Value, _
targetDir & “\” & Range(“c” & CStr(gyo + 7)).Value & “.” & fs.GetExtensionName(Range(“B” & CStr(gyo + 7)).Value), _
False
End If

gyo = gyo + 1

Loop Until gyo > 999 ‘1000超えたら

Set fs = Nothing

Exit Sub

ErrorHandler:
Close
MsgBox “エラーです”, 0, “困ったことに”
Set fs = Nothing
Exit Sub

End Sub

Private Sub Button1_Click()
Call StartFileCopy

End Sub

Private Sub SetFilePath(ByVal StartTarget As Range)
Set fs = CreateObject(“Scripting.FileSystemObject”)

flist = Application.GetOpenFilename( _
FileFilter:=”すべてのファイル,*.*, エクセルファイル,*.xlsx, ワードファイル,*.docx”, _
FilterIndex:=1, _
MultiSelect:=True _
)

If IsArray(flist) Then
For i = 1 To UBound(flist)
Range(“B” & CStr(StartTarget.Cells.Row + i – 1)).Value = flist(i)
Next
End If

Set fs = Nothing

End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

‘ダブルクリックした位置よりファイルパスを登録処理
If Target.Cells.Column = 2 And Target.Cells.Row >= 7 Then
Cancel = True
Call SetFilePath(Target)
End If

End Sub

列ごとに複数列追加するマクロ

何度か使いそうな用件があったので、作ってみた。

選択した列範囲に指定した行数追加していくexcel用vbaマクロ

Sub 列を追加する()
'選択列の後ろに指定数挿入

Dim N As Integer
Dim startC, endC, currentC As Long
Dim LoopCount As Long
Dim i As Long
Dim LoopArea As Range
Dim SelectArea As String

SelectArea = Selection.Address
Set LoopArea = Selection

'挿入したい列数を
N = 3

'状況取得
startC = LoopArea.Cells(1).Column
endC = LoopArea.Cells(LoopArea.Count).Column

'挿入処理
LoopCount = endC - startC + 1
currentC = startC

'画面描画抑止
Application.ScreenUpdating = False

For i = 0 To (LoopCount - 1)
    With ActiveSheet
        .Range(.Columns(currentC + 1), .Columns(currentC + N)).Insert
    End With
    currentC = currentC + N + 1
Next

'画面描画の再開
Application.ScreenUpdating = True

End Sub

Excel bookの修復

画像とかたくさん貼ったエクセルのブックを再び開いてみたら「問題があります」など言われて原形をとどめていないようなテキストデータしか表示されない。

MSのhelpにあるような開いて修復やっても同じ状態という時、OpenOffice.orgで開いたら開けた!
なんてことがありました。

小ネタ。

表を貼る

表スタイルが搭載されたバージョンのAutoCADにExcelから表をAutoCADオブジェクトとして貼ると、勝手に表になる。
表スタイルのコントロールが煩わしい自分にはとても邪魔な機能。

そこで、Excelでのコピーを「図としてコピー」にしてから貼り付けたらAutoCAD2004あたりでの貼り付け動作と同じになった。
もうしばらくこの方法でやっちゃおうかと。

AutoCADの表はどうも中途半端でね。。

シートをまとめるマクロ

自分のところに書いておいて後でコピペで使う。便利だけど、DNSチェックとかいろいろ制限を受ける環境下ではメールサーバに置いておく方が良いんだよね。

といいつつ、今日縁あって作ったマクロ。

book内のシートを全部結合します。
積算ソフトから出力したbookとかだと使えるかもね。

‘##################
‘連結くん
‘##################
Sub jointSheets()
Dim sheetAll As Worksheet
Dim NumCurrRow As Long
Dim NumJoint As Integer
NumCurrRow = 1
NumJoint = 0

‘画面更新の停止
Application.ScreenUpdating = False

‘先頭にワークシートを1枚追加
Set sheetAll = Worksheets.Add(before:=Worksheets(1))
sheetAll.Name = “__ALL__”

For Each sh In Sheets
If sh.Name <> Worksheets(1).Name Then
sh.UsedRange.Copy
sheetAll.Cells(NumCurrRow, “A”).Select
sheetAll.Paste
NumCurrRow = NumCurrRow + sh.UsedRange.Rows.Count

NumJoint = NumJoint + 1
End If
Next

MsgBox NumJoint & “枚のシートを結合しました。”, vbOKOnly, “おしらせ”

sheetAll.Activate
sheetAll.Cells(1, “A”).Select

‘画面更新の再開
Application.ScreenUpdating = True

End Sub

実際使っていないので、動作確認はちゃんとやろう。
2003以前のexcelだと65536行を超えるとエラーになるでしょう。
また、__ALL__っていうシートが既にあると、確実にエラーです。

データフォーム入力で複数行を入力する方法

Excelに作った表にデータを入力していく際、カーソル操作が出てくると入力が遅くなってしまうのでデータフォーム入力を使うことが結構多いのですが、

入力項目が1セルに複数行あると「どうしたらよいの?」なんて事になるのですが、このデータフォームで複数行を入力するには改行したいところでCtrl + Jを押します。

入力欄が消えたように見えますが、ちゃんと改行されています。

検索、置換にも同じ方法が使えるので、1セルに複数行入力されているものを探すときや複数行入力されている箇所で改行解除の時に検索対象にCtrl + Jを入れて置換すれば1行表示になります。