Accessの値をExcelに縦横入替出力したい
- AccessからデータをExcelVBAでADOを使用して読み込み、縦横を入れ替えたいがrecordcountが-1を返す問題について解決法を教えてください。
- 質問文章の中で回答を頂いたが、依然としてrecordcountが-1を返し解決できない状況です。
- 現在は一旦AccessからデータをVBAで読み込み、transpose関数を使用して入れ替えていますが、縦横を入れ替えた状態に出力する方法を知りたいです。
- ベストアンサー
Accessの値をExcelに縦横入替出力したい
以前 http://okwave.jp/qa/q8776430.html ここにて質問をさせて頂いたのですが、回答を頂いたことに感激し お恥ずかしい事に解決する前に先走って回答を締めきったものの どうしても解決できないので申し訳ないですが再度質問させて下さい。 質問：AccessからデータをExcelVBAでADOを使用して読み込み、 出力する前に縦横を入れ替えたいのですが その際に, adOpenstatic、adOpenKeyset などカーソルのタイプを変更しても recordcountが-1を返してしまうのですが、解決法を教えてください。 以下補足です。 -------------------------------------------------------------------- 現在、作業列を使って一旦AccessからデータをVBAでADOを使用して読み込み その後transpose関数で入れ替えているのですが 出力する前に縦横を入れ替えた状態にはできないのでしょうか？ -------------------------------------------------------------------- という質問に対して、 Dim buf() As Variant Dim i As Long Dim j As Long ・ 'ここにAccessファイルへのコネクションを設定 ・ ・ i = rs.Fields.Count j = rs.RecordCount ReDim mbuf(i - 1, j - 1) buf = rs.GetRows Range(Cells(1, 1), Cells(i, j)) = buf ------------------------------------------------------------- という回答を頂き パス（省略） Sub AcRecordCount() Dim tmpFldCnt As Variant Dim tmpRecCnt As Variant Dim buf() As Variant Call DBconnect(True) （省略） strSQLgenyu = _ "SELECT * " & _ "FROM TBL " & _ "WHERE コード = " & Range("J1") & _ "Or コード = " & Range("J2") 'J1、J2に一致したwhereフィールドの列を、fromテーブル名から全て(*)を出力 adoRs.Open strSQLgenyu, adoCn, adOpenKeyset 'SQLを実行して、対象をadoRsへ MsgBox (adoRs.RecordCount) '-1が返ってくる tmpFldCnt = adoRs.Fields.Count tmpRecCnt = adoRs.RecordCount ReDim buf(tmpFldCnt - 1, tmpRecCnt - 1) 'インデックスが有効範囲にありませんとでる（恐らくrecordcountが原因） buf = adoRs.GetRows Range(Cells(131, 11), Cells(tmpFldCnt, tmpRecCnt)) = buf Range("EA11:JJ105").ClearContents 'セル内を削除 Range("EA11").CopyFromRecordset adoRs '出力 End Sub と、書いたのですが、-1が返ってきてしまいます。 原因は何なのでしょうか？
- fwod
- お礼率54% (47/86)
- Excel（エクセル）
- 回答数4
- ありがとう数4
- みんなの回答 （4）
- 専門家の回答
質問者が選んだベストアンサー
コード表の参照設定で、ADOにチェックが はいっているのでしょうか。それと、 ＞今回の質問である、縦横変換出力しない状態でなら ＞これらを使用し、縦に出力されるはずです。 は確認済みですか？ カーソルタイプはadOpenKeysetでいいとは思いますが。
その他の回答 (3)
- piroin654
- ベストアンサー率75% (692/917)
Acceessのフィルはmdbですか、あるいはaccdbですか。 それとバージョンは？ 気になるのは、 パス（省略） このパスの使い道と、 Call DBconnect(True) （省略） この関数の存在ですが、これらは間違いなく 使用されたり、機能していますか。
お礼
解決しました、ありがとうございました
補足
回答ありがとうございます。 Access2007にて、mdeファイルを使用しています。 パス（省略）の部分は -------------------------------------------------------- '宣言 Private adoCn As Object Private adoRs As Object Private strSQL As String Private Const DBpath = "\Access.mde" 'Accessファイルのパス指定 --------------------------------------------------- Call DBconnect(true) （省略） の部分は Sub DBconnect(flg As Boolean) 'DB呼出 Set adoCn = CreateObject("ADODB.Connection") If flg = True Then Set adoRs = CreateObject("ADODB.Recordset") adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBpath & ";" End Sub としています。 今回の質問である、縦横変換出力しない状態でなら これらを使用し、縦に出力されるはずです。
- piroin654
- ベストアンサー率75% (692/917)
＞adoRs.Open strSQLgenyu, adoCn, adOpenKeyset を adoRs.Open strSQLgenyu, adoCn, adOpenStatic, adLockReadOnly としてみたらどうですか。これで取得できますが。
お礼
解決しました、ありがとうございました
補足
回答ありがとうございます、 そのように実行したところ 実行時エラー'3001': アプリケーション定義またはオブジェクト定義のエラーです。 とでます。 ちなみに定数をadLockReadOnlyにした場合のみこのようなエラーがでます。
- bin-chan
- ベストアンサー率33% (1403/4213)
ステップ実行してみては？ 「レコードセットOPEN直後にレコード数を取得できない」なら OPEN直後に以下２行を追加してからレコード数を取得してみて。 adoRs．MoveLast adoRs．MoveFirst
お礼
解決しました、ありがとうございました
補足
回答ありがとうございます。 adoRs.Open strSQLgenyu, adoCn, adOpenKeyset 'SQLを実行して、対象をadoRsへ adoRs.MoveLast adoRs.MoveFirst MsgBox (adoRs.RecordCount) このように記述して試してみたところ 実行時エラー'-2147217884(80040e24)': オートメーションエラーです。 と出ました。 windowsupdateも行なっているので、基本的なファイルはそろっていると思うのですが・・・
関連するQ&A
- エクセルでのアクセスからのデータ抽出
Web情報を参考にエクセルにて下記VBAコードを作りました。 Sub DB_Read() Dim adoCON As New ADODB.Connection Dim adoRS As New ADODB.Recordset Dim strSQL As String Dim odbdDB As Variant Dim wSheetName As Variant Dim i, j As Integer Dim GetName odbdDB = ActiveWorkbook.Path & "\test.accdb" adoCON.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;" _ & "Data Source=" & odbdDB & "" adoCON.Open j = 4 Do Until j = 18 GetName = Range("B4").Value & "_" & Cells(16, j).Value strSQL = "SELECT 規格値,Max,Min,結果1,結果2,結果3 FROM T_測定結果 WHERE [測定項目]='" & GetName & "'" adoRS.Open strSQL, adoCON, adOpenDynamic wSheetName = ActiveSheet.Name i = 20 adoRS.MoveLast Do Until adoRS.EOF Or i = 25 With Worksheets(wSheetName) .Cells(17, j).Value = adoRS!規格値 .Cells(18, j).Value = adoRS!Max .Cells(19, j).Value = adoRS!Min .Cells(i, j).Value = adoRS!結果1 .Cells(i + 10, j).Value = adoRS!結果2 .Cells(i + 20, j).Value = adoRS!結果3 End With i = i + 1 adoRS.MovePrevious Loop j = j + 1 Loop adoRS.Close Set adoRS = Nothing adoCON.Close Set adoCON = Nothing End Sub VBAを走らせると1巡は走るのですが、「Do Until j = 18」の2巡目に入ると、「wSheetName = ActiveSheet.Name」のところで「実行時エラー3705 アプリケーション定義またはオブジェクトの定義エラー」と出てしまいます。 エラーの原因が分からないので、アドバイスを頂きたいです。
- ベストアンサー
- Excel（エクセル）
- 可変の検索条件件数でAccessデータを抽出
http://okwave.jp/qa/q8790348.html ここで質問をさせて頂いたのですが 私の質問方法が下手で、違う意味合いになっていましたので再度投稿させてください。 ■ やりたい事 ADOを用いて、Accessのテーブル内のフィールドに「指定の数値」がある場合 その行を全てExcelに抽出したい ■ 特徴 「指定の数値」は複数あり、なおかつ可変。 → VBAで作成したコンボボックス（Accessから読込）にて選択し、F45から下に好きな個数だけ追加 ■ つまづき点 「指定の数値」全てを検索対象に（OR検索）して SQLのSelect文で取得しようとしてもやり方が分からない ■ 現在のコード '宣言 Private adoCn As Object Private adoRs As Object Private strSQL As String Private Const DBpath = "\Access.mde" Sub DBconnect(flg As Boolean) 'DB呼出 Set adoCn = CreateObject("ADODB.Connection") If flg = True Then Set adoRs = CreateObject("ADODB.Recordset") adoCn.Open "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & DBpath & ";" End Sub Sub 対象() Dim tmpFldCnt As Variant Dim tmpRecCnt As Integer Dim buf() As Variant Call DBconnect(True) m = Worksheets("選択").Range("B47") Dim i As Long Dim j As Long i = 45 j = 44 + Worksheets("選択").Range("B47") 'B47：コンボボックスで選んだ個数分の数値 On Error GoTo err_hander adoCn.BeginTrans 'トランザクション処理開始 strSQL = _ "select * from TBL where コード = [選択$F" & i & ":F" & j & "]" 'F45より下に取得した値が入っていく adoRs.Open strSQL, adoCn, adOpenKeyset 'SQLを実行して、対象をadoRsへ tmpFldCnt = adoRs.Fields.Count tmpRecCnt = adoRs.RecordCount Range("M28:DG31").ClearContents ReDim buf(tmpFldCnt - 1, tmpRecCnt - 1) buf = adoRs.GetRows Range(Cells(28, 13), Cells(28 + tmpFldCnt - 1, 13 + tmpRecCnt - 1)) = buf adoCn.CommitTrans 'トランザクション終了 Call DBcut_off(True) 'DB切断呼び出し Exit Sub 色々と調べてみたものの、解決する気配がせず、どなたか知恵をお貸しください。
- ベストアンサー
- Excel（エクセル）
- Accessから値を抽出しようとするとフリーズする
Excelからマクロを用いてAccessファイルからデータを拾おうとしています。 方法は、Access内のテーブルを参照して検索対象の値１がフィールド内にあれば、その行の値２を抽出してくるといったものです。 検索対象の数は可変です。 そこでコードを書いてみたところ 抽出件数が2件以上なら正常に動作するのですが 1件、0件だと動作せず、フリーズしてしまいます。 何が原因で、どう書き直せばよいのでしょうか？ 以下、コードです。 Private Sub OKButton_Click() '選択し、OKボタンを押した時 Dim p As Long Dim cnt As Long Range(Cells(45, 4), Cells(114, 6)).ClearContents 'D45～E115のセルを削除（二回目使用時にデータが残ってる為） cnt = ListView1.ListItems.Count '今まで選択してリストビューに追加された対象数を出し、変数へ。 For p = 1 To cnt Cells(44 + p, 4).Value = ListView1.ListItems.Item(p) Cells(44 + p, 5).Value = ListView1.ListItems.Item(p).SubItems(1) Cells(44 + p, 6).Value = ListView1.ListItems.Item(p).SubItems(2) Next p 'リストビューに追加された対象を、D45～E115に書き込み Dim Sql As String Dim i As Long Dim j As Long Dim k As Long Dim m As Long Dim n As Long Call DBconnect(True) Sql = _ "select Ａコード,Ｂコード " & _ "from テーブル" '--- adoRsにSELECT文を入れ、絞り込む adoRs.Open Sql, adoCn, adOpenKeyset ' --- j：選択した対象の数を取得 k：Access内の選択した対象のデータ数を取得 n：列数 j = Worksheets("選択").Range("F45").End(xlDown).Row k = adoRs.Fields.Count n = 1 '--- Aコードが一致する行を選択シートの下部分へ書き込み。 ' --- 45 to jの45は、選択シートの選択した対象をセルに出力した場所が45行目の為。 ' --- cell(j+n,6)は、選択対象数を起点にBコード（値2）一つ毎に数を足していく、6はF列 Do Until adoRs.EOF For i = 45 To j If Worksheets("選択").Cells(i, 6).Value = adoRs!Aコード Then For m = 1 To k Worksheets("選択").Cells(j + n, 6) = adoRs.Fields!Bコード Next m n = n + 1 End If Next i adoRs.MoveNext Loop '後始末 adoRs.Close: Set adoRs = Nothing adoCn.Close: Set adoCn = Nothing
- ベストアンサー
- Excel（エクセル）
- AccessからExcelに罫線付で出力したい
Access2010使用。 AccessのクエリからExcelにエクスポートした際、罫線などの体裁を整えて出力したいと思っています。 データは下記のコードでなんとか出るようになりましたが、このコードの中に罫線を引くコードを 入れる方法がどうしてもわかりません。 検索してあれこれ試しましたが「オブジェクトがない」や「サポートしてない」などエラーメッセージ が出てしまい、ＶＢＡの基礎知識がない私にはどうしてもわかりませんでした。 どうかアドバイスお願いいたします。 （クエリ名は Q_ABC とします） やりたいことは ・データがある行列に格子線を引き、１行目の項目列の下は二重線、外側は太線にしたい。 ・行の高さを数値で指定したい。 です。なお、行数はその都度増えます。 また、できれば 印刷する際の設定で用紙を「Ａ３横」で、常に横１ページに入るように縮小率を設定しておきたい のですが可能でしょうか？ どうぞよろしくお願いします。 Private Sub コマンド0_Click() Set xlapp = CreateObject("Excel.application") Dim xlbook As Excel.Workbook Dim xlsheet As Excel.Worksheet Dim rs As New ADODB.Recordset Dim objEXCEL As Object Dim nYLINE As Integer Dim nXLINE As Integer Dim nRCNT As Integer Dim strWORK As String Set xlApp = CreateObject("Excel.Application") Set objEXCEL = CreateObject("Excel.Application") objEXCEL.Visible = True objEXCEL.Workbooks.Add objEXCEL.sheets.Add re.Open "Q_ABC", CurrentProject.Connection, adOpenKeyset, adLockOptimistic '見出しを書き込む objEXCEL.Range("A1") = "ID" objEXCEL.Range("B1") = "氏名" objEXCEL.Range("C1") = "住所" == 以下T列まで省略 == '項目名をセルの中央に objEXCEL.Range("A1:T1").HoraizontalAlignment = xlHAilignCenterAcrossSelection Dim yLINE As Integer '行カウンター yLINE = 2 'ループ処理 While rs.EOF = False 'accessからデータのセット objEXCEL.Cells(yLINE, "A") = rs.Fields("ID") objEXCEL.Cells(yLINE, "B") = rs.Fields("氏名") objEXCEL.Cells(yLINE, "C") = rs.Fields("住所") == 以下T列まで省略 == rs.MoveNext yLINE = yLINE + 1 Wend 'シートの列幅の自動調整 objEXCEL.Cells.EntireColumn.AutoFit rs.Close Set rs = Nothing End Sub
- ベストアンサー
- オフィス系ソフト
- accessからexcelへ出力時。。。
３つのクエリを一つのエクセルシートへ出力しようとしているのですが、 3つ目が張り付きません。なんでなんでしょうか？どなたか教えてください。 Dim dbs As Database Dim rst1 As Recordset Dim rst2 As Recordset Dim rst3 As Recordset Dim intRow As Integer Dim intCell As Integer Dim xlsx As Object Set dbs = CurrentDb Set rst1 = dbs.OpenRecordset("クエリA") Set rst2 = dbs.OpenRecordset("クエリB") Set rst3 = dbs.OpenRecordset("クエリC") Set xlsx = CreateObject("Excel.Application") 'Excelオブジェクトを生成 With xlsx .ScreenUpdating = False '画面の再描画を抑止 .Workbooks.Add '新しいブックを追加 '---"クエリA"---------------------------------------------------- intRow = 1 For intCell = 1 To rst1.Fields.Count .Cells(intRow, intCell).Value = rst1.Fields(intCell - 1).Name .Cells(intRow, intCell).Interior.ColorIndex = 15 Next intCell '各レコード出力 intRow = 2 Do Until rst1.EOF For intCell = 1 To rst1.Fields.Count .Cells(intRow, intCell).Value = rst1.Fields(intCell - 1) Next intCell intRow = intRow + 1 rst1.MoveNext Loop '集計Sum For intCell = 4 To rst1.Fields.Count .Cells(intRow + 1, intCell) = "=SUM(" & Cells(2, intCell).Address & ":" & Cells(intRow, intCell).Address & ")" Next intCell ・ ・2目のクエリはOK ・ ・ ’以下3つ目のクエリ Dim intRow3 As Integer Dim intCell3 As Integer intRow3 = intRow + 5 intCell3 = 5 For intCell3 = 5 To rst3.Fields.Count .Cells(intRow3, intCell3).Value = rst3.Fields(intCell3 - 1).Name .Cells(intRow3, intCell3).Interior.ColorIndex = 15 Next intCell3 '各レコード出力 intRow3 = intRow + 6 Do Until rst3.EOF For intCell3 = 5 To rst3.Fields.Count .Cells(intRow3, intCell3).Value = rst3.Fields(intCell3 - 1) Next intCell3 intRow3 = intRow3 + 1 rst3.MoveNext Loop '---- Dim rst3RC As Integer rst3RC = intRow + 5 + rst3.RecordCount '863 '集計Sum For intCell3 = 6 To rst3.Fields.Count - 1 .Cells(rst3RC, intCell3) = "=SUM(" & Cells(rst3RC - rst3.RecordCount, intCell3).Address & ":" & Cells(rst3RC - 1, intCell3).Address & ")" Next intCell3
- 締切済み
- Visual Basic
- エクセル マクロ 範囲指定。
先日、ＯＫWAVEのサイトでエクセルマクロの質問をさせていただき 下記の回答を活用したいのでしが myKey = Worksheets("Sheet2").Range("A1").ValueをＡ１Ａ２・・・Ａ５０のように 50個を一度に処理したいのですがどのように変更すればよろしいのでしようか 自分なりに調べてみましたが知識がなくできませんでした ご回答のいただいたmitarashiさんにお聞きしたいのですがお聞きする手段がわからず 再度、質問させていただきます。 宜しくお願いいたします。 Sub test() Dim targetRange As Range Dim buf As Variant Dim i As Long, j As Long, myColorIndex As Long Dim myKey As Variant Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set targetRange = Worksheets("Sheet1").Range("J10:BB10000") buf = targetRange myColorIndex = 4 myKey = Worksheets("Sheet2").Range("A1").Value With targetRange For i = 1 To UBound(buf, 1) For j = 1 To UBound(buf, 2) If buf(i, j) = myKey Then .Cells(i, j).Interior.ColorIndex = myColorIndex Next j Next i End With Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub
- 締切済み
- Visual Basic
- EXCEL VBAの配列でわかりません。
こんなコードがあるのですが、最後の他のシート（作業中シート）に書き込もうとするとエラーになってしまいます。”Sheets("作業中").”を抜くと同じシートに結果は返ってくるのですが…。コードの内容は、ある範囲のある列から空白ではないセルを探し出してその行のデータを配列で汲み取り、他のシートに一括で洗い出すというものです。 Sub 作業中() Dim myRow As Long Dim Data As Variant Dim WC() As Variant Dim WCE() As Variant myRow = Range("H1").CurrentRegion.Rows.Count Data = Range("H1:M" & myRow).Value For i = 1 To myRow If Data(i, 5) <> "" Then a = a + 1 Else b = b + 1 End If Next ReDim WC(a) ReDim WCE(b) c = 0 d = 0 For i = 1 To myRow If Data(i, 5) <> "" Then WC(c) = Range("H" & i & ":K" & i).Value c = c + 1 Else WCE(d) = Range(Cells(i, 8), Cells(i, 11)).Value d = d + 1 End If Next For i = 0 To a Range(Cells(i + 1, 15), Cells(i + 1, 18)).Value = WC(i) Next For i = 0 To b Range(Cells(i + 1, 19), Cells(i + 1, 22)).Value = WCE(i) Next e = Range(Cells(1, 15), Cells(a, 18)).Value Sheets("作業中").Range(Cells(1, 1), Cells(a, 4)).Value = e End Sub ちなみに同じシートから↓のコードを実行するとうまくいきます。 なぜ～？？わからな～い？？おしえてくださーい！！ Sub test() Dim a As Variant a = Range("H1:K4") Sheets("作業中").Range("N1:Q4") = a End Sub
- ベストアンサー
- オフィス系ソフト
- EXCELへのデータ出力
VB6.0で開発しています。 下記のようにEXCELへのデータ出力は出来たのですが EXCELのシートのA列とB列は文字列にしたいのです。 今はA列とB列に数字を入れると右詰になってしまいます。 どうすればいいでしょうか？ 教えてください。 Dim s3cn_ado As variant Dim dsn As String Dim tbl As String Dim tky As String Dim sql As String Dim rs As variant Dim fnm As String Dim mds As boolean Dim fno As Integer Dim i As Integer Dim j As Integer Dim k As long Dim s As String Dim ct As long Dim exl As Object dsn = "dsn=SAK3_ADO;uid=SAK;pwd=SAK" tbl = "sak.受注m" tky = "受注番号 = ''" '0 件のダミー問い合わせ用のキー" fnm = "g:\tmp\test.xls" mds = true set s3cn_ado = CreateObject ("ADODB.Connection") s3cn_ado.Open dsn sql = "select * from " & tbl & " where " & tky set rs = s3cn_ado.Execute(sql) j = rs.fields.count - 1 redim ctyp(j) as boolean For i = 0 to j select case rs(i).type case 131, 139 ctyp(i) = true case else ctyp(i) = false end select Next rs.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 s3cn_ado.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) sql = "insert into " & tbl & " values (" & s & ")" s3cn_ado.Execute sql if err <> 0 then s3cn_ado.RollbackTrans close fno s3cn_ado.Close msgbox "更新エラー" & chr(10) & err & ": " & error _ & chr(10) & ct + 1 & " 件目に問題あり" _ & chr(10) & sql end end if ct = ct + 1 next s3cn_ado.CommitTrans on error goto 0 exl.Application.DisplayAlerts = False exl.Application.Quit s3cn_ado.Close
- ベストアンサー
- Visual Basic
- EXCELのVBAでのCSVファイル読込みと検索
エクセルのマクロでCSVファイルを読み込み、その行の得意先サブコードをキー項目として別のCSVファイルを検索し電話番号とFAX番号を取得するという作業を下記のようなコードで作成しました。 Dim Obj As Object Dim Path As String Dim FName As String Dim i As Long Dim buf As String Dim tmp As Variant Dim WSH As Variant Dim CN As ADODB.Connection Dim RS As ADODB.Recordset '自分のPCのデスクトップをPathとして設定します。 Set WSH = CreateObject("Wscript.Shell") Path = WSH.SpecialFolders("Desktop") & "\" '得意先マスタ.csvをOPENする際の準備処理 '3行目のPropertiesがCSVファイルの定義(excelをOPENする時とは異なります) Set CN = New ADODB.Connection CN.Provider = "Microsoft.Jet.OLEDB.4.0" CN.Properties("Extended Properties") = "Text;HDR=YES;FMT=Delimited" CN.Open Path '得意先サブマスタ.CSVを開きます。 Open Path & "得意先サブマスタ.csv" For Input As #1 i = 1 Do Until EOF(1) Line Input #1, buf tmp = Split(buf, ",") If i = 1 Then Else Cells(j, 1).Value = Left(tmp(3), 4) '会社コード Cells(j, 2).Value = Right(tmp(3), 4) '店舗コード Cells(j, 3).Value = tmp(3) '会社＠店舗 Cells(j, 4).Value = tmp(4) '得意先コード Cells(j, 5).Value = tmp(5) '店舗名 Set RS = New ADODB.Recordset RS.Open "SELECT * FROM 得意先マスタ.csv WHERE 得意先コード = " & tmp(4) & " ", CN If RS.EOF Then Cells(j, 6).Value = "???" Cells(j, 7).Value = "???" Else Cells(j, 6) = RS.Fields("電話番号") Cells(j, 7) = RS.Fields("FAX番号") End If End If i = i + 1 Loop このコードで動作確認すると途中で動作が止まってしまい応答なし状態になってしまいます。どこで止まるかは一定ではありません。CSVファイルの内容も確認したのですが、特におかしいような箇所はありませんでした。 OSはWINDOWS７、EXCELは2016です。 コード自体に修正した方がいいような箇所があればアドバイスいただきたいと思っております。宜しくお願い致します。
- ベストアンサー
- Excel（エクセル）
- エクセルマクロ 検索して値を取得
マクロはよく分かっていません。 既存のVBAを見ながらマネしてる状態なので、どこが間違っているのか教えて下さい。 sheet1 A 所属 1 789 2 3 sheet2 A B 所属コード 所属 1 12345 あいう123 2 12346 あいう456 3 12347 あいう789 やりたいこと シート１の所属が「789」だったらとシート２の所属から「あいう789」を検索し、シート２の所属コード「12347」をシート１の所属に返す。 私が作ったやつだと「12347」は１行目でなく、３行目に返ってしまいます。 Dim SyozokuRange as Range Dim Syozoku as String Dim Buf as String Buf = "あいう" Syozoku = Buf & Syozoku Set SyozokuRange = worksheets(2).range("a:b").currentregion For i = 1 to SyozokuRange.rows.count If Syozoku = SyozokuRange.cells(i,2) Then worksheets(1).cells(i,1).value = SyozokuRange.cells(i,1) end if next i
- 締切済み
- オフィス系ソフト
お礼
すいません、少し考えれば分かることでした 解決致しました、本当にありがとうございました。
補足
回答ありがとうございます、コード表の参照設定にてチェックが入っていなかったのが原因でした。 （縦の出力はチェックを入れる前でも問題なく出力されました） 助かりました、ありがとうございます。 また、よろしければ教えていただきたいのですが この状態で任意のセルから入れ替えした値を出力するには ReDim buf(tmpFldCnt - 1, tmpRecCnt - 1) buf = adoRs.GetRows Range(Cells(1, 1), Cells(tmpFldCnt, tmpRecCnt)) = buf これをどう変更するとよいのでしょうか？ いろいろいじってみたものの、自分の望んだ結果にはなりませんでした。