人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

コメント欄にある動作をするマクロを作ってください。お気持ちのみですが合計で300P差し上げます(最初の方に重点配分)。1つは100pです。
pdfの表からエクセルファイルに表を移すときに生じたズレを修正するプログラムです。


よろしくお願い申し上げます。

●質問者: ReoReo7
●カテゴリ:コンピュータ ウェブ制作
✍キーワード:PDF エクセル コメント欄 ファイル プログラム
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● Mook
●300ポイント ベストアンサー

一応仕様通りにしたつもりです。

仕様との違いがあれば、コメントください。


【1】

'-----------------------------------------------
Sub oneline()
'-----------------------------------------------
 Dim lastRow As Long
 lastRow = Range("A" & Rows.Count).End(xlUp).Row
 
 Dim i As Long
 Dim flgJoin As Boolean
 
 Dim dstLastCol As Long
 Dim srcLastCol As Long
 
 Application.ScreenUpdating = False
 
 For i = lastRow To 2 Step -1
 flgJoin = False
 If IsNumeric(Cells(i, "A").Value) Then
 If (Len(Cells(i, "A").Value) > 3) Then
 flgJoin = True
 End If
 Else
 flgJoin = True
 End If
 If flgJoin = True Then
 dstLastCol = Cells(i - 1, 255).End(xlToLeft).Column
 srcLastCol = Cells(i, 255).End(xlToLeft).Column
 Range("A" & i).Resize(1, srcLastCol).Copy Destination:=Cells(i - 1, dstLastCol)
 Rows(i).Delete
 End If
 Next
 Application.ScreenUpdating = True
End Sub

【2】

'-----------------------------------------------
Sub del()
'-----------------------------------------------
 Dim lastRow As Long
 lastRow = Range("B" & Rows.Count).End(xlUp).Row
 
 Dim i As Long
 Dim ch As Variant
 
 Application.ScreenUpdating = False
 For i = 1 To lastRow
 For Each ch In Array(".", "/", "$", "%", "(", ")") '★ 削除する文字列
 Cells(i, "B").Value = Replace(Cells(i, "B").Value, ch, "")
 Next
 Next
 Application.ScreenUpdating = True
End Sub

【3?1】

'-----------------------------------------------
Sub delspace()
'-----------------------------------------------
 Dim lastRow As Long
 lastRow = Range("B" & Rows.Count).End(xlUp).Row
 
 Dim regEx
 Set regEx = CreateObject("VBScript.RegExp")
 regEx.Global = True
 

 Application.ScreenUpdating = False
 
 Dim i As Long

'--- 先頭の空白を削除
 regEx.Pattern = "^[  ]+"
 For i = 1 To lastRow
 Cells(i, "B").Value = regEx.Replace(Cells(i, "B").Value, "")
 Next

'--- 最後の空白を削除
 regEx.Pattern = "[  ]+$"
 For i = 1 To lastRow
 Cells(i, "B").Value = regEx.Replace(Cells(i, "B").Value, "")
 Next
 Application.ScreenUpdating = True

End Sub

【3?2】

'-----------------------------------------------
Sub joint()
'-----------------------------------------------
 Dim lastRow As Long
 lastRow = Range("B" & Rows.Count).End(xlUp).Row
 
 Dim regEx
 Set regEx = CreateObject("VBScript.RegExp")
 regEx.Global = True
 regEx.Pattern = "[  ]+"
 
 Application.ScreenUpdating = False
 
 Dim i As Long
 For i = 1 To lastRow
 Cells(i, "C").Value = regEx.Replace(Cells(i, "B").Value, "-")
 Next
 Application.ScreenUpdating = True
End Sub
◎質問者からの返答

どうも、ありがとうございます!


2 ● きゃづみぃ
●100ポイント
Sub oneline()
 Dim b As Long
 d = 2
 For a = 2 To 65536
 If Cells(d, 1) = "" Then Exit For
 b = Val(Cells(d, 1))
 If b <> Cells(d, 1) Then
 For c = 1 To 256
 If Cells(d - 1, c) = "" Then Exit For
 Next c
 
 For e = 1 To 256
 If Cells(d, e) = "" Then
 Rows(d).Delete
 d = d - 1
 Exit For
 Else
 Cells(d - 1, c) = Cells(d, e)
 c = c + 1
 End If
 Next e
 End If
 
 d = d + 1
 Next a
End Sub

Sub del()
  'カラム2行目だけ削除
 Columns(2).Replace ".", ""
 Columns(2).Replace "/", ""
 Columns(2).Replace "%", ""
 Columns(2).Replace "(", ""
 Columns(2).Replace "$", ""
 Columns(2).Replace ")", ""
End Sub

Sub delspace()
 For a = 1 To 65536
 If Cells(a, 2) = "" Then Exit For
 Cells(a, 2) = Trim(Cells(a, 2))
 Next a
End Sub

Sub joint()
 For a = 255 To 2 Step -1
 Columns(2).Replace Space(a), " "
 Next a


 For a = 1 To 65536
 If Cells(a, 2) = "" Then Exit For
 Cells(a, 3) = Cells(a, 2)
 Next a
 
 Columns(3).Replace " ", "-"
 
End Sub


一番目のがちょっと面倒でしたね。

◎質問者からの返答

いつもありがとうございます。参考にさせて頂きます。やはりちょっと面倒でしたか...

PDFの表をExcelにするのにいい方法ってないんでしょうかね?

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ