VBAで外部ブックの空行を詰めるコードとは?

このQ&Aのポイント
  • VBAで外部ブックの空行を詰めるコードについて教えてください。
  • エクセル関数で処理する方法と、SQL文で行や列を空にする方法があるようですが、詰める方法が分かりません。
  • 具体的なコードがあれば教えてください。
回答を見る
  • ベストアンサー

VBAで外部ブックの空行を詰めるコードとは?

 添付図を見れば、「何やら SQL文を使っているな!」と思う向きもあるかと思います。が、実際は、エクセル関数で処理しています。それも、VBAでシートを読み書きしたユーザーなら多分最初に覚えるもの。ところが、当方は、先頃まではエクセルを開いたことがないド素人、いわゆるマクロを書いたのは、たったの一週間前。ですから、SQL文で該当する行や列を空にすることは出来ても、詰めるなんてことは到底に無理。と、思って、あーでもないこうでもないと思案すること3日。で、さっき、偶然に《空白行の詰め方は一行で出来る》というネット上の回答を発見。で、無事に、添付図のところまで辿り着きました。   strTableName = CutStr(CutStr(strSQL, "[", 2), "]", 1)   strSheetName = CutStr(strTableName, "$", 1)   strRange_S = CutStr(CutStr(strTableName, "$", 2), ":", 1)   strRange_E = CutStr(CutStr(strTableName, "$", 2), ":", 2)   '   ' Set文   '   Set objWorksheet = ThisWorkbook.Worksheets(strSheetName)   '   ' 空白行を消す   '   objWorksheet.Range(strRange_S & ":" & strRange_E).SpecialCells(xlCe…  が、次のステップが、さっぱり分かりません。次のステップとは、外部ブックのシートへの適用。多分、Set文のところに12行追加するだけかと思います。  この RowsClear() は、二つのブロックから構成されています。 Public Function RowsClear(ByVal strSQL As String, _              Optional xlFileName As String = "", _              Optional isHeader As Boolean = True) As Boolean  SQL文が削除を指示している行に null を代入するブロック   ↓  空白行の削除するブロック End Function  前半は、今開いているブックのシート、外部のシートを問わずに更新できています。ここら辺のコードは、エクセルの知識に疎い私にも書けます。問題は、後半部です。 [イミディエイト] ? SQLExecute("DELETE FROM [Sheet2$A1:K11] WHERE ID>4 AND ID<7", "D:\Book2.Xlsx") True  これで、前半ブロックは、目的を達しています。なら、後半も出来て当然と思います。でも、そのやり方が分かりません。宜しく、ご協力の程お願いします。

質問者が選んだベストアンサー

  • ベストアンサー
  • kon555
  • ベストアンサー率52% (1751/3360)
回答No.3

【補足】 ちなみに余談として Set objWorksheet = ThisWorkbook.Worksheets~ の"ThisWorkbook."を純粋に削除してもマクロは動きます。 このようなブックの指定が無い場合、アクティブなブックの該当シート名のシートに対し働きます(該当シート名が無い場合はエラー)。 こうしたマクロの状態で、マクロ自体をクイックツールバーに登録しておくと「現在開いているシート」を対象にマクロを実行できます。 実務上はこちらの方が楽なことも多いのでご紹介しておきます。

f_a_007
質問者

お礼

 お陰様で、何とかSQLのINSERT文、UPDATE文、DELETE文で自分あるいは指定の外部ブックを更新するSQLExecute()を書き上げることが出来ました。マイクロソフトは、Jetエンジンにエクセル固有の制限をかけています。そこで、プログラマ諸氏は、一旦、テーブルを保存して再作成するなどの手法を取ってDELETE文を実現しているようです。「ウン、なーんか違うなー・・・」と思って、今回の挑戦とあいなった次第です。「素直に、DELETE文を実行して発生した空行を詰めるべきでは」が、私の考え。で、その挑戦に自分を追い込むための質問。お付き合いありがとうございました。重ねて、お礼を申し上げて質問を締め切ります。なお、テストはしていません。後々のお楽しみにとっておきます。

その他の回答 (2)

  • kon555
  • ベストアンサー率52% (1751/3360)
回答No.2

あ、ごめんなさい勘違いしていました。既に目的の動作は達成できているんですね。それを別ブックのシートで行いたいと。 その場合は Set objWorksheet = ThisWorkbook.Worksheets(strSheetName) の"ThisWorkbook"の部分を目的のブックに変えてやればよいです。 その場合、 「対照ブックは元々開いているか」 「対照ブックを"ファイルを開く"形式で指定したいか」 などによって変わりますが、既にプログラム関係の知識がおありなら http://officetanaka.net/excel/vba/file/file02.htm の辺りを見ればすぐに組めるのではないでしょうか。

f_a_007
質問者

お礼

>対照ブックは元々開いているか」 >「対照ブックを"ファイルを開く"形式で指定したいか」 >などによって  この指摘にドキッ。急いで、次の関数を書きました。 Public Function BookIsOpened(ByVal wbName As String) As Boolean On Error Resume Next   BookIsOpened = Len(Workbooks(wbName).Name & "") > 0 End Function     '     ' Set文     '     If Not BookIsOpened(xlFileName) Then       Set objWorkbook = Workbooks.Open(xlFileName)       Set objWorksheet = objWorkbook.Worksheets(strSheetName)     Else       Set objWorksheet = ThisWorkbook.Worksheets(strSheetName)     End If  先の1行も6行に変身。テストはしていません。が、多分、この線でいけると思います。ただ、この書き方が、エレガントなそれであるかは大いに疑問。生まれた初めてのの6行ですから・・・。後は、閉じ方。それは、未経験ですのでやってみなくちゃー分かりません。が、山は、越えたようです。  私も70歳。VBAコードを書くのは、実に23年振り。そして、エクセルの操作経験と関数の知識は完ゼロ。まあ、ともかく苦労の連続です。 >無知なることに挑むのが一番難しい! を痛感する日々です。  昨晩のテストで《削除対象となった実際の列数》《削除後の行数》という課題にもぶつかりました。まあ、これなんかも、エクセルの関数で求めるなんて私には無理。で、あくまでも我流で解決。  とにもかくにも、SQLExecute()が完成すれば、この度のエクセルへの挑戦は終了します。大変、貴重なアドバイスをありがとうございました。お礼を申し上げておきます。

f_a_007
質問者

補足

 お礼を投稿して、「えっ!」と気が付いたんですが・・・。ELSE文は間違っていましたね。関数の冒頭で If Len(xlFileName) = 0 Then   xlFileName = ThisWorkbook.FullName End If と、指定ブックであれThisWorkbookであれ、xlFileNameでオープンあるいは処理できるように仕掛けていたのに・・・。すっかり、それを失念していました。大分、ボケが進行しているようです。

  • kon555
  • ベストアンサー率52% (1751/3360)
回答No.1

ううむ・・・一旦SQL文云々は忘れて、シンプルに「エクセルで何をどうしたいのか」を書いてみて下さい。 おそらくその方面のスキルをお持ちの上で試行錯誤なさってるのだと思うのですが、エクセル上で処理するならもっとシンプルな構文や方法があると思います。 とくにエクセルVBAは「エクセルを熟知した人間ならこんな風に作業する」という考え方で組む向きもありますので、一度その段階から提示していただければ、有用な知見が集まるかと思いますが・・・。

f_a_007
質問者

補足

>シンプルに「エクセルで何をどうしたいのか」を書いてみて下さい。 1、シート[顧客台帳]から[売上台帳]に過去2年間に注文がない顧客を削除する。 2、シート[売上台帳]に2年間を経過した注文記録を削除する。 3、シート[従業員名簿]から退職して2年が経過した従業員を削除する。 4、シート[営業成績]から[従業員名簿]で退職とされた従業員の記録を削除する。  ・ただし、あくまでも[テーブル]として使用している範囲の列を削除すること。 などなどです。

関連するQ&A

  • エクセルVBAでエラー!

    エクセルでVBAを組んでいます。 Aシート・Bシートにデータがあり、それをSQLで集計し、 Cシートに出力をしたいのですが、 『リンクされているExcelのワークシートを表示するための接続が切断されました。』 というエラーが出て、解決しません。 (調べてみましたが、似たような例がなく解決には至りませんでした・・・。) どなたかご教示お願い致します。 Private Sub CommandButton1_Click() Dim dbCon As Object Dim dbCols As Object Dim dbRes As Object Dim strSQL As String Dim sh1 As Worksheet Set sh1 = Worksheets("Cシート") Set dbCon = CreateObject("ADODB.Connection") dbCon.Provider = "Microsoft.Jet.OLEDB.4.0" dbCon.Properties("Extended Properties") = "Excel 8.0" dbCon.Open ThisWorkbook.FullName strSQL = "" strSQL = strSQL & "SELECT *" strSQL = strSQL & vbCrLf & "FROM [Aシート$] LEFT JOIN [Bシート$] ON [Aシート$].NO= [Bシート$].NO" Set dbRes = CreateObject("ADODB.Recordset") dbRes.Open strSQL, dbCon, adOpenKeyset, adLockReadOnly sh1.Range("A1").CopyFromRecordset dbRes dbRes.Close Set dbRes = Nothing dbCon.Close Set dbCon = Nothing End Sub

  • VB6でのSQL実行について

    VB6でのSQL実行について VB6でのSQL実行について困っています。 SQL文を作成し、ダイナセットで実行している最中にも 再度別のSQL文をダイナセットで実行することは可能なのでしょうか? 言語はVB6.0、DBはOracle9iを使用しています。 イメージ的にはこんな使い方をしたいです。 dim lngRecordRow1 as long 'レコード数1 dim lngRecordRow2 as long 'レコード数2 dim OraDynaset1 As OraDynaset dim OraDynaset2 As OraDynaset dim strSQL as string 'SQL文 dim lngCnt1 as long 'ループカウンタ1 dim lngCnt2 as long 'ループカウンタ2 strSQL= ---SQL文作成1回目--- Set OraDynaset1 = OraDatabase.CreateDynaset(strSQL, ORADYN_READONLY) 'SQL文実行1回目 lngRecordRow1 = OraDynaset1.RecordCount for lngCnt1 = 1 to lngRecordRow1 '--- 処理 --- strSQL= ---SQL文作成2回目--- Set OraDynaset2 = OraDatabase.CreateDynaset(strSQL, ORADYN_READONLY) 'SQL文実行2回目 lngRecordRow2 = OraDynaset2.RecordCount for lngCnt2 = 1 to lngRecordRow2 '--- 処理 --- next lngCnt2 next lngCnt1 1回目で取得したSQL実行結果を行単位でループをまわしつつ、1回目で取得したレコードの結果を条件に使用して別のSQL文を作成し、ループをまわしている最中に実行したいです。 その際、2回目のSQLの結果が2レコード以上の場合、さらにループをまわして条件判別をしたいです。 かなり困っています。回答待ってます。

  • ADOでアクセスからエクセルシートの件数を取得した

    ADOでアクセスからエクセルシートの件数を取得したいのですが、うまく行きません。 アクセスの標準モジュールに Sub ADO_TEST1() Const StrFileName = "D:\My Documents\検索.xls" Dim dbCon As ADODB.Connection Dim dbRes As ADODB.Recordset Dim i As Long Dim strSQL As String ' Connection生成 Set dbCon = New ADODB.Connection With dbCon .Provider = "Microsoft.Jet.OLEDB.4.0" .Properties("Extended Properties") = "Excel 8.0" .Open StrFileName End With ' SQL文作成 strSQL = "SELECT * FROM [Access接続用$];" Set dbRes = New ADODB.Recordset dbRes.Open strSQL, dbCon, adOpenDynamic, adLockOptimistic, adCmdText i = dbRes.RecordCount MsgBox "エクセルのAccess接続用シートの最終行は、" & i & "行です。" dbRes.Close: Set dbRes = Nothing dbCon.Close: Set dbCon = Nothing End Sub ************************************************************* を貼り付けて実行すると、エラーにはならないのですが-1が返ってきます。 実際の行は、200行あります。 ここで、エクセルの最終行を取得して、いづれエクセルのデータをアクセスのテーブルに転記したいのですが まずここで躓いてしまったので、 ・dbRes.RecordCountで、-1が返ってくる原因 ・エクセルの該当のシートの最終行の取得の仕方 をご教授ください。 ご回答よろしくお願いします。

  • データの取り込み

    VB6.0 SQLSERVER で開発しています。  EXCELにあるデータをSQLへ取り込みたいのですが 下記のようにすると取り込めるのですが EXCELに空白があるとエラーが出ます。 教えてください。  Dim strSQL As String Dim adoRsWork As ADODB.RecordSet Dim exl As Object Dim i As Integer Dim k As Long Dim mds As Boolean Dim rs As Variant Dim j As Integer Dim s As String Dim ct As Long Dim fno As Integer Dim fnm As String strSel1 = "SELECT" strSel1 = strSel1 & " A.品番" strSel1 = strSel1 & ",A.品名" strSel1 = strSel1 & ",A.倉番" strSel1 = strSel1 & ",A.数量" strFro1 = " FROM " strFro1 = strFro1 & " A_zaiko AS A" strSQL = strSel1 & " " & strFro1 Debug.Print (strSQL) Set adoRsWork = pbAdo.OpenRecordset(strSQL) Set exl = CreateObject("Excel.Sheet") mds = True fnm = "C:\Documents and Settings\デスクトップ\159.xls" j = adoRsWork.Fields.Count - 1 ReDim ctyp(j) As Boolean For i = 0 To j Select Case adoRsWork(i).Type Case 131, 139 ctyp(i) = True Case Else ctyp(i) = False End Select Next adoRsWork.Close Set exl = CreateObject("Excel.Application") exl.Application.Visible = True exl.Application.Workbooks.Open FileName:=fnm k = 1 If mds Then k = 2 End If gSvrADOActiveconnection.BeginTrans On Error Resume Next For k = k To 65536 s = "" If exl.Cells(k, 1) = "" Then Exit For For i = 0 To j If ctyp(i) Then s = s & "," & exl.Cells(k, i + 1) Else s = s & ",'" & exl.Cells(k, i + 1) & "'" End If Next s = Mid(s, 2) strSQL = "insert into " & strFro1 & " values (" & s & ")" pbAdo.OpenRecordset (strSQL) If Err <> 0 Then gSvrADOActiveconnection.RollbackTrans Close fno adoRsWork.Close MsgBox "更新エラー" & Chr(10) & Err & ": " & Error _ & Chr(10) & ct + 1 & " 件目に問題あり" _ & Chr(10) & strSQL End End If ct = ct + 1 Next gSvrADOActiveconnection.CommitTrans On Error GoTo 0 exl.Application.DisplayAlerts = False exl.Application.Quit adoRsWork.Close

  • EXCEL(VBA)で1行おきに行を選択する方法

    こんにちは。VBAは苦手なので教えてください。 EXCELのsheet1にあるリストに、下記マクロで1行おきに 空白行を挿入しました。 Sub test1() '隔行で空白行を挿入 Dim rw As Long 'セル For rw = Range("A1").End(xlDown).Row To 2 Step -1 Rows(rw).Insert Next End Sub 同じファイルのSheet2の1行目<Rows("1:1")>に、計算式が入力されています。 マクロで挿入した空白行全てを選択し、そこへSheet2の1行目のコピーを 貼り付けたいです。 ぜひ、良い方法を教えてください。

  • VBAでBOOKを開かずにプロパティ変更

    エクセル2013です。 特定のフォルダ内のエクセルのBOOKのプロパティの作成者をすべて変えようと思います。 いろいろ試して、以下のコードでできるようになりました。 しかし、下記のコードではいちいちファイルを開かなくてはなりませんのでサイズが大きかったり、数が多いと結構時間がかかります。 手作業でファイルのプロパティを変えるときは、エクスプローラで右クリックすれば開かなくとも簡単にできます。VBAでもファイルを開かずにプロパティを変更するにはどうすればよいのでしょうか?お教えいただければ幸いです。 Sub TEST20190710()   Dim myFdr As String, fnm As String   Dim wb As Workbook   Dim n As Long   Const NEW_AUTHOR As String = "emaxemax"      Application.ScreenUpdating = False   Application.EnableEvents = False   myFdr = "C:\Users\User\Documents\TEST01"   fnm = Dir(myFdr & "\*.xls?")   Do Until fnm = Empty     Set wb = Workbooks.Open(myFdr & "\" & fnm)     Application.DisplayAlerts = False     wb.BuiltinDocumentProperties("Author").Value = NEW_AUTHOR     wb.Close SaveChanges:=True     Application.DisplayAlerts = True     n = n + 1     fnm = Dir   Loop   Application.ScreenUpdating = True   Application.EnableEvents = True   MsgBox n & "件のブックを処理しましました。", vbInformation End Sub

  • エクセルVBAでcommit,rollback

    エクセルVBAでcommit,rollback 初めて質問させていただきます。 エクセルVBAを一人で学習しています。 仕事で使ったことも、教えてもらったこともほとんどありませんのでほぼ初心者です。 今、エクセルファイルを二つ使って、一つをデータベースに、もう一つでそのデータベースを 利用するようなプログラムを書いています。 それで、2つの関連するテーブル(シート)を同時に変更(update)する必要があるのですが、 何らかのエラーが起きてしまったときのことを考えて、トランザクションを利用 出来たらと思っています。 いろいろググってアクセス用のコードを見つけたので、それを元に下のようなプログラムを 書いて試してみたのですが、ロールバックが効かずに更新されてしまいます。 '******** 定数 *********** Const cnsProvider = "Microsoft.Jet.OLEDB.4.0" Const cnsExtProp = "Extended Properties" Const cnsExcel = "Excel 8.0" Const cnsDBName = "SAMPLE_DB.xls" Const cnsYen = "\" '******** プログラム *********** Sub ADO_update_test() Dim dbCon As ADODB.Connection Dim strSQL As String ' -- Connection生成 -- Set dbCon = New ADODB.Connection With dbCon .Provider = cnsProvider .Properties(cnsExtProp) = cnsExcel .Open ThisWorkbook.Path & cnsYen & cnsDBName End With ' -- トランザクション開始 -- dbCon.BeginTrans ' -- sql作成 -- strSQL = "update [Sheet1$] set 金額 = 300 where ID = '001';" ' -- sqlを流す -- dbCon.Execute (strSQL) ' -- rollback -- dbCon.RollbackTrans ' -- クローズ・コネクション解放 -- dbCon.Close: Set dbCon = Nothing End Sub 1、まずこの様なことが可能なのかどうか 2、出来るとしたらどのようにすればいいのか(間違っている点を指摘してください) 以上の2点についてお答えをいただけるとありがたいです。 よろしくお願いいたします。

  • エクセル VBA SQL 開始行の指定

    namatyu MC285Pさんの質問からの解答を利用させていただいて、会社の履歴表を作成しましたが、訳あって、(資材受け入れシート)側の開始行をA1からA2に変えた所、「パラメータがすくなすぎます。14を指定してください」と出てしまいます。 Sheets("資材受け入れシート").Range("A1:D1").Copyを Sheets("資材受け入れシート").Range("A2:D2").Copyに変えても解決しません… SQL文が勉強不足で、変更場所が分かりません   1   2   3  4  受入日 品名  Lot  数量   7/7   A  BNR32  10   7/8   A  BNR32  5   7/10   B  SW200  2   7/7   B  AE860  4   7/8   B  SW200  12   7/9   C  GD300  10   7/7   C  GD300  1   7/7   C  DC200  7 Sub test()   Dim strSql As String   Dim cnXL As Object   Dim rsXL As Object   Const adOpenForwardOnly = 0         Sheets("資材受け入れシート").Range("A1:D1").Copy   Sheets("資材受け入れシート").Paste Destination:=Worksheets("Sheet2").Range("A1:D1")   Application.CutCopyMode = False      Set cnXL = CreateObject("ADODB.Connection")   Set rsXL = CreateObject("ADODB.Recordset")   With cnXL     .Provider = "MSDASQL"     .ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};" & _     "DBQ=" & ThisWorkbook.FullName & "; ReadOnly=True;"     .Open   End With   strSql = "select max(受入日) as 日付,品名,Lot,sum(数量) as 合計" _         & " from [資材受け入れシート$]" _         & " group by 品名,Lot order by max(受入日),品名,Lot"      Debug.Print strSql   rsXL.Open strSql, cnXL, adOpenForwardOnly   Worksheets("sheet2").Cells(2, 1).CopyFromRecordset rsXL   Worksheets("sheet2").Columns("A:A").NumberFormatLocal = "m/d"      rsXL.Close: Set rsXL = Nothing   cnXL.Close: Set cnXL = Nothing   MsgBox "Sheet2に出力しました" End Sub 色々、試したのですが、分かりません… すいませんが、どたたか教えてください、お願いします。

  • Excel VBA Accessへデータ書き込み

    お世話になります。 Excel VBAを使用し、ExcelのデータをAccessのテーブル書き込みたいと思っています。 そこで、Access側のテーブルのインデックス重複なしの設定により、書き込むExcelデータが重複となるレコードの場合は、警告を非表示にして書き込みを飛ばしたいと思い、書籍等を参考にして下記のようなコードを記述したのですが、DoCmd.SetWarnings Falseに対してDoCmdの変数が定義されていませんと警告が出されます。 DoCmd.SetWarnings Falseを記述しないと実行時エラーが出されます。 対応方法をご教授頂けないでしょうか。 よろしくお願い致します。 Option Explicit Sub ExcelカレントExcelデータをAccessへ_重複除外_今村() Dim con As New ADODB.Connection Dim rs As New ADODB.Recordset Dim conStr As String Dim sqlList As Collection Set sqlList = New Collection 'コレクションを作成 Dim titleRow As Long Dim endRow As Long Dim tgtRow As Long '繰り返し用変数の宣言 Dim sql As Variant 'SQL文用変数の宣言 Dim i As Long 'For iステートメント用 Dim wbws As Object Dim Accessteble As String 'ExcelのWorkbook名+Sheet名を指定 Set wbws = Workbooks("テーブル取り込み1.xlsm").Sheets("Sheet2") 'Accessのテーブル名を指定 Accessteble = "T_Excelデータ追加" 'Excelタイトル行初期化★ titleRow = 9 'Excelデータ最終行取得 endRow = wbws.Cells(Rows.Count, 2).End(xlUp).Row 'SQL文リストの作成 'Excelデータ取得 For i = titleRow + 1 To endRow '指定行を繰り返す With wbws sql = _ "INSERT INTO " & Accessteble & "(" & _ .Cells(titleRow, 2).Value & ", " & _ .Cells(titleRow, 3).Value & ", " & _ .Cells(titleRow, 4).Value & ") " & _ "VALUES(" & _ "'" & .Cells(i, 2).Value & "', " & _ "'" & .Cells(i, 3).Value & "', " & _ .Cells(i, 4).Value & ");" End With 'コレクションへ追加 sqlList.Add sql Next i 'iを次の値にしてForへ戻る 'Access絶対パス指定 conStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data " & _ "Source=C:\Users\○○\Desktop\注文管理.accdb" 'DB接続 con.Open ConnectionString:=conStr DoCmd.SetWarnings False '実行文 For Each sql In sqlList 'SQL文リストをループ con.Execute sql '1行ずつ取り出し実行 Next sql con.DoCmd.SetWarnings True con.Close: Set con = Nothing End Sub

  • マクロがあるファイルの読み出し時にマクロの有効を聞いてこないようにする。

    以下のようにエクセルのブックのシート名をゲットしようとしたのですが、エクセルにマクロを入れてあるため、「マクロの有効、無効」を聞いてきます。 聞いてこないようにするため xlApp.DisplayAlerts = False を入れたのですが、ダメでした。なにか良い方法はあるのでしょうか? 宜しくお願いいたします。 Dim FileNam As String Dim filebasho As String Dim wbsinario As Object Dim shtsinario As Object Dim ExcelWasNotRunning As Boolean If Err.Number <> 0 Then ExcelWasNotRunning = True Err.Clear ' xlApp.DisplayAlerts = False Set shtsinario = GetObject(filebasho & "\" & FileNam) Set wbsinario = shtsinario.Application.Workbooks(FileNam)

専門家に質問してみよう