end-u の回答履歴

全1157件中1081~1100件表示
  • マクロの登録を使って、オートシェイプどうしをカギ線矢印コネクタでつなぐ

    今年入社した新人で、コンピュータ系の会社に勤めてます。 プログラミング経験は全くないので細かく教えていただきたいです。 エクセルのマクロを使って、以下のような処理をしたいと 思っています。 エクセルシート上に長方形のオートシェイプが何個かあります。 (バーのような細いものです。) それをクリックすると「他の図形とコネクタ線でつなぎますか?」と いう質問がでて、「はい」を選択します。 そして他のつなぎたいオートシェイプをクリックすると、 その元の図形の右端とつなぎたい図形の左端がカギ線矢印コネクタでつながる、といったマクロを作りたいです。 一応msgboxまではできていますが、つなぐための文がわかりません。 Sub AutoShape_Connect() If MsgBox ("他の図形とコネクタ線でつなぎますか?" ,vbYesNo + vbQuestion = vbYes then うまく伝わっていますでしょうか? ぜひよろしくお願いします。

  • dictionary教えてください。

    いつもお世話になります。 sheet1   A列---B列--- りんご---青森--- みかん---静岡--- バナナ---東京--- な し---鳥取--- sheet2   A列---B列--- りんご---倉庫1--- みかん---倉庫2--- な し---倉庫1--- sheet3   A列---B列---C列--- りんご---青森---倉庫1 みかん---静岡---倉庫2 な し---鳥取---倉庫1 ディクショナリーを使って sheet1と2の重複するものを、sheet3のB列C列に書き出す VBAを教えてください。 Sheet1内・Sheet2内での重複はありません。 VLOOKUP関数を書き込んで出すというのは マクロでできましたが、どうしてもディクショナリでのコード 知りたいのです。 いろいろと調べましたが、 配列の取り方が二つのシートになるとどうしても 自分で作れません。 どなたかご教授ください。 お願いします。

  • カレントドライブの変更をしても、そのマクロの実行ができない

    VIsta SP1 ExcelXPでマクロ作成中の超初心者です。今日昼から4時間かけて試行錯誤しましたが、深みにはまるばかりで、途方に暮れています。お助けください。  1)現状    Aブック-----マクロ記述用    Bブック-----請求用紙データ  2)Bブックにマクロを記述しました。そのマクロはBブックから正常に実行できました。  3)Bブックのマクロを、Aブックに複写し、カレントフォルダを変更しても、そのマクロがAブックにしか実行されません。このマクロををBブックに実行したいのですが、どうしてもできません。ご教示をお願いします。

  • VBAでWebクエリにて情報を自動収集するプログラム

    自動売買ロボット作成マニュアルという本を買いました。 これは株などを自動売買するプログラムを作るための方法が書いた本です。(言語はエクセルに搭載されてあるVBAというプログラム言語です) そのプログラムを作る過程で、まずYahoo!ファイナンスから株価などの情報を10年分自動収集するプログラムを作ったのですが、「インターネットサーバーに接続できません」と出て、きちんと実行できません。 そこで、デバックをすると.Refresh BackgroundQuery:=Falseというプログラムのところがチェックされました。どうしたらいいでしょうか? この文章だけでは対処できないと思いますのでプログラムを書いておきます。長々とお読みいただきありがとうございます。どうかお知恵をお貸しください。 Dim url As String Dim lastrow As Integer Dim i As Integer Sub Get_Data() With ActiveSheet.QueryTables.Add(Connection:=url, Destination:=Cells(lastrow, 2)) .Name = _ "t?s=998407.o&a=4&b=22&c=2008&d=7&e=24&f=2008&g=d&q=t&y=0&z=998407.o&x=_1" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "19" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With End Sub Sub Calc() Dim code As String Dim data_length As Integer, date_temp As Date Dim day_s As Integer, month_s As Integer, year_s As Integer Dim day_e As Integer, month_e As Integer, year_e As Integer Dim row_length As Integer code = "998407.o" data_length = -3650 date_temp = DateAdd("d", data_length, Now) day_e = Day(Now) month_e = Month(Now) year_e = Year(Now) day_s = Day(date_temp) month_s = Month(date_temp) year_s = Year(date_temp) Range("B4:H65000").ClearContents For i = 0 To Abs(data_length) * 0.65 Step 50 url = "URL; http://table.yahoo.co.jp/t?s=" & code & "&a=" & month_s & "&b=" & day_s & "&c=" & year_s & "&d=" & month_e & "&e=" & day_e & "&f=" & year_e & "&g=d&q=t&y=" & i & "&z=" & code & "&x=.csv" If i = 0 Then lastrow = "4" Call Get_Data If Range("B4") = "" Then Exit Sub End If Else lastrow = (Range("B4").End(xlDown).Row + 1) Call Get_Data Range("B" & lastrow, "H" & lastrow).Delete row_length = (Range("B4").End(xlDown).Row) If row_length - lastrow < 49 Then Exit For End If End If Next Range("B5:H65000").Sort Key1:=Columns("B") lastrow = Range("B4").End(xlDown).Row Range("B5", "B" & lastrow).NumberFormatLocal = "yyyy/mm/dd" Range("C5", "H" & lastrow).NumberFormatLocal = "0" Range("A1").Select End Sub

  • カレントドライブの変更をしても、そのマクロの実行ができない

    VIsta SP1 ExcelXPでマクロ作成中の超初心者です。今日昼から4時間かけて試行錯誤しましたが、深みにはまるばかりで、途方に暮れています。お助けください。  1)現状    Aブック-----マクロ記述用    Bブック-----請求用紙データ  2)Bブックにマクロを記述しました。そのマクロはBブックから正常に実行できました。  3)Bブックのマクロを、Aブックに複写し、カレントフォルダを変更しても、そのマクロがAブックにしか実行されません。このマクロををBブックに実行したいのですが、どうしてもできません。ご教示をお願いします。

  • Excel VBA:エクセルのマクロで入力規則を設定する際のアラートの扱いがわからず困っています

    エクセルでINDIRECTを使った入力規則設定をマクロで行う際の、アラートの扱いがわからず困っており、お教えいただけると幸いです。 例えば、A列に日付、B列にその日付に行った都道府県名、C列にはB列で選択した都道府県に属する自治体名を入れる場合を考えます。 そのために、  ・北海道、青森、…という具合に都道府県名のリストに、あらかじめ『都道府県名』と言う名前をつけたものを作成しておく。  ・洞爺湖、阿寒湖、釧路、…という北海道の自治体名リストにあらかじめ『北海道』と言う名前をつけたものを作成しておく。  ・弘前、八戸、十和田、…という青森県の自治体名リストにあらかじめ『青森』と言う名前をつけたものを作成しておく。   :(以下同様) と言う準備をしたあと  -B列の入力規則ダイアログボックスで、入力値の種類を『リスト』、元の値として『=都道府県名』とすることでドロップダウンリストから都道府県名を選ぶことが出来ます。  -C列の入力規則ダイアログボックスで、入力値の種類を『リスト』、元の値として『=INDIRECT(B1)』とすることでドロップダウンリストから自治体名を選ぶことが出来ます。   C列の規則を設定する際にB列にまだ都道府県名が入っていない場合は『元の値はエラーと判断されます。続けますか?』と言うアラートが出ますがOKを押して続行。 とすれば、C列のドロップダウンリストでB列で選択した都道府県に属する自治体名が選べることになります ここまでは、教科書などにも書いてある内容なので問題はないのですが、これをマクロ化すると問題が発生します。 上記の入力規則の設定をマクロで記録し、実行すると  『実行時エラー'1004'.アプリケーション定義またはオブジェクト定義のエラーです。』 が発生します。エラーの起こっている場所はC列の入力規則定義部分の .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= xlBetween, Formula1:="=INDIRECT(B1)" のようです。 B列に都道府県名が入った状態ではエラーとはならないので、マクロ記録時に『元の値はエラーと判断されます。続けますか?』が出てOKとした部分が 何らかの問題となっているとは思うのですが、対処方法がわからずに困っております。 ちなみに、On Error Resume Nextを入れておいたとしても、エラーでマクロが中断されることはなくなりますが、入力規則の設定は行われないので対処方法にはなりません。 質問が長くなり恐縮です。 コピーペーストなどで入力規則の設定が消えてしまうことがあるので、ブックの立ち上げ時に入力規則の再定義をしたいと考え、このような質問となりました。 対処方法おわかりの方、ご教授いただけると大変助かります。 なお、環境はwindowsXP、excel2003です。 よろしくお願いいたします。

  • VBAでWebクエリにて情報を自動収集するプログラム

    自動売買ロボット作成マニュアルという本を買いました。 これは株などを自動売買するプログラムを作るための方法が書いた本です。(言語はエクセルに搭載されてあるVBAというプログラム言語です) そのプログラムを作る過程で、まずYahoo!ファイナンスから株価などの情報を10年分自動収集するプログラムを作ったのですが、「インターネットサーバーに接続できません」と出て、きちんと実行できません。 そこで、デバックをすると.Refresh BackgroundQuery:=Falseというプログラムのところがチェックされました。どうしたらいいでしょうか? この文章だけでは対処できないと思いますのでプログラムを書いておきます。長々とお読みいただきありがとうございます。どうかお知恵をお貸しください。 Dim url As String Dim lastrow As Integer Dim i As Integer Sub Get_Data() With ActiveSheet.QueryTables.Add(Connection:=url, Destination:=Cells(lastrow, 2)) .Name = _ "t?s=998407.o&a=4&b=22&c=2008&d=7&e=24&f=2008&g=d&q=t&y=0&z=998407.o&x=_1" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "19" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With End Sub Sub Calc() Dim code As String Dim data_length As Integer, date_temp As Date Dim day_s As Integer, month_s As Integer, year_s As Integer Dim day_e As Integer, month_e As Integer, year_e As Integer Dim row_length As Integer code = "998407.o" data_length = -3650 date_temp = DateAdd("d", data_length, Now) day_e = Day(Now) month_e = Month(Now) year_e = Year(Now) day_s = Day(date_temp) month_s = Month(date_temp) year_s = Year(date_temp) Range("B4:H65000").ClearContents For i = 0 To Abs(data_length) * 0.65 Step 50 url = "URL; http://table.yahoo.co.jp/t?s=" & code & "&a=" & month_s & "&b=" & day_s & "&c=" & year_s & "&d=" & month_e & "&e=" & day_e & "&f=" & year_e & "&g=d&q=t&y=" & i & "&z=" & code & "&x=.csv" If i = 0 Then lastrow = "4" Call Get_Data If Range("B4") = "" Then Exit Sub End If Else lastrow = (Range("B4").End(xlDown).Row + 1) Call Get_Data Range("B" & lastrow, "H" & lastrow).Delete row_length = (Range("B4").End(xlDown).Row) If row_length - lastrow < 49 Then Exit For End If End If Next Range("B5:H65000").Sort Key1:=Columns("B") lastrow = Range("B4").End(xlDown).Row Range("B5", "B" & lastrow).NumberFormatLocal = "yyyy/mm/dd" Range("C5", "H" & lastrow).NumberFormatLocal = "0" Range("A1").Select End Sub

  • VBAでWebクエリにて情報を自動収集するプログラム

    自動売買ロボット作成マニュアルという本を買いました。 これは株などを自動売買するプログラムを作るための方法が書いた本です。(言語はエクセルに搭載されてあるVBAというプログラム言語です) そのプログラムを作る過程で、まずYahoo!ファイナンスから株価などの情報を10年分自動収集するプログラムを作ったのですが、「インターネットサーバーに接続できません」と出て、きちんと実行できません。 そこで、デバックをすると.Refresh BackgroundQuery:=Falseというプログラムのところがチェックされました。どうしたらいいでしょうか? この文章だけでは対処できないと思いますのでプログラムを書いておきます。長々とお読みいただきありがとうございます。どうかお知恵をお貸しください。 Dim url As String Dim lastrow As Integer Dim i As Integer Sub Get_Data() With ActiveSheet.QueryTables.Add(Connection:=url, Destination:=Cells(lastrow, 2)) .Name = _ "t?s=998407.o&a=4&b=22&c=2008&d=7&e=24&f=2008&g=d&q=t&y=0&z=998407.o&x=_1" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "19" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With End Sub Sub Calc() Dim code As String Dim data_length As Integer, date_temp As Date Dim day_s As Integer, month_s As Integer, year_s As Integer Dim day_e As Integer, month_e As Integer, year_e As Integer Dim row_length As Integer code = "998407.o" data_length = -3650 date_temp = DateAdd("d", data_length, Now) day_e = Day(Now) month_e = Month(Now) year_e = Year(Now) day_s = Day(date_temp) month_s = Month(date_temp) year_s = Year(date_temp) Range("B4:H65000").ClearContents For i = 0 To Abs(data_length) * 0.65 Step 50 url = "URL; http://table.yahoo.co.jp/t?s=" & code & "&a=" & month_s & "&b=" & day_s & "&c=" & year_s & "&d=" & month_e & "&e=" & day_e & "&f=" & year_e & "&g=d&q=t&y=" & i & "&z=" & code & "&x=.csv" If i = 0 Then lastrow = "4" Call Get_Data If Range("B4") = "" Then Exit Sub End If Else lastrow = (Range("B4").End(xlDown).Row + 1) Call Get_Data Range("B" & lastrow, "H" & lastrow).Delete row_length = (Range("B4").End(xlDown).Row) If row_length - lastrow < 49 Then Exit For End If End If Next Range("B5:H65000").Sort Key1:=Columns("B") lastrow = Range("B4").End(xlDown).Row Range("B5", "B" & lastrow).NumberFormatLocal = "yyyy/mm/dd" Range("C5", "H" & lastrow).NumberFormatLocal = "0" Range("A1").Select End Sub

  • エクセルのVBAでの7×7の魔方陣とは……

    講義の宿題で7×7の魔方陣をVBAで解いてこいといわれました。 しかしながら自分のスキルではどうにもなりませんでした。 自分はIFやDim等までしか習っていません。 課題の注意点としては 1から49までの数値を検出 「1」は1行目の中央(4列目)に書き出す 基本的に、数値の書き出す順番は斜め上に移動 また、書き込む数値を「7」で割った場合の余りが「1」の時 書き込みの場所は下方向に移動する。 枠をはみ出した場合   上にはみ出した(行)の場合  7行目に   右にはみ出した(列)の場合  1列目に  それぞれ移動 以上のような条件でエクセルのVBEを用いて解きたいのですが、どうにも分かりません。自分でも様々なサイトで調べてみたところどれも難しすぎて理解できませんでした。 心優しき方は教えていただけると幸いです。 よろしくお願いします。

  • 除外シートの連続印刷をしたい

    Vista SP1 Excel2000でマクロを作成中の超初心者です。 マクロコードの修正でエラー続出。四苦八苦しています。どうぞお助けください。 ---------------------------------------------------------------------------- イ)現在使用しているマクロを次のように修正したい。 (1)表紙.xls に次のコードを追加する。     Public Const EXCEPT_NAME = "一覧表, 印刷1, データ集, 請求見本" (2)表紙.xls の次のコードを削除する。    '開始   mySh = Array("A会社", "B会社", "C会社", "D会社",・・・ZZ会社") (3)代わりに、次のコードを使用する。  For Each SheetName In ActiveWorkbook.Worksheets 'すべての会社シートをアクティブにする  If InStr(EXCEPT_NAME, SheetName.Name) = 0 Then  Sheets(SheetName.Name).Activate ------------------------------ ア)現在の状況   デスクトップにAAフォルダがあります。その中身は     1)表紙.xls------コード記述用(シート名は「表紙」1枚のみ)     2)BBフォルダ       請求書.xls-----             シート名(1)A会社, B会社, C会社, D会社,・・・ZZ会社                (2)一覧表, 印刷1, データ集, 請求見本-----このシートは印刷しない。 イ)現在使用しているマクロ Sub 請求書連続印刷()  Application.ScreenUpdating = False  ChDrive ThisWorkbook.Path  ChDir ThisWorkbook.Path Workbooks.Open (ThisWorkbook.Path & "\BBフォルダ\請求書.xls") Worksheets("印刷1").Activate Dim mySh As Variant Dim i As Long '請求印刷面のデータの削除 Worksheets("印刷1").UsedRange.Clear '開始 mySh = Array("A会社", "B会社", "C会社", "D会社",・・・ZZ会社") For i = LBound(mySh) To UBound(mySh) Worksheets(mySh(i)).Unprotect 'プロテクトを外す Call 印刷時削除項目 Worksheets(mySh(i)).Range("A1:Q44").Copy _ Worksheets("印刷1").Cells((i + 1) + 43 * i, 1) Worksheets(mySh(i)).Protect 'プロテクトを掛ける Next Application.CutCopyMode = False Worksheets("印刷1").PrintPreview Application.CutCopyMode = False ActiveWorkbook.Close False

  • VBA(エクセル)で自動的にボタンをクリックさせるには

    いつもお世話になっております。 下記のことがしたいのですがどうやって良いのかがわからなくって困っております。 やりたいこと。 AブックとBブックが有るとします。(双方ともエクセルファイル) エクセルのVBAで、Aブックのシート上のコマンドボタンを押すと Bブックのシート上のコマンドボタンをクリックするという動きを VBAでさせたいのですがどうしてもクリックさせることができません。 試したこと。 初めは、AのボタンをクリックするとBのボタンをセレクトして SendKeysでENTERを送ってみたりしたのですがうまくいきませんでした。 何かやり方が有りましたら、お教えいただけませんでしょう。 宜しくお願いいたします。

  • VBAでオートフィルタの可視セルクリア後空白行削除がうまくできません

    VBA初心者です。 オートフィルターで抽出した行を削除したくて、以下のように書いたのですが、最後の一文でエラーになってしまいます。 ◆エラー内容◆ 実行時エラー1004 重複する選択範囲に対してそのコマンドを使用することはできません。 ◆書いたVBA◆   Range("A2").Select Selection.AutoFilter Field:=1, Criteria1:="=1111", Operator:=xlAnd 'オートフィルターで「1111」を抽出 Dim r As Range Set r = Range(Range("A3"), Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible) r.ClearContents 'A列の可視セルの値をクリア Range("A2").Select Selection.AutoFilter 'オートフィルターの解除 r.SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'A列が空白の行は削除→ ココがエラーになります --------------------------------------------------------- 元のファイル構成は2行目に項目名で、3行目からデータが入っています。 いろいろ調べたのですが、よくわからなかったので教えていただければ 幸いです。 宜しくお願いします。

    • 締切済み
    • noname#64671
    • Visual Basic
    • 回答数1
  • VBA特定セルの値により、他のセルの値を変更する

    いつもお世話になっております。 以下のような表で・・・       {A}     {B}  {C}   {D}   {E}   {F}    {G}    {H}    {I}   {J}    {K} {1} 氏名  住所  電話   1月   3月   7月   10月   処理(1) 処理(2) 処理(3) 処理(4)    {2} A     XXX  000-00  (1)   (2)   (3)    (4)   1月   3月   7月  10月 {3} B  TTT    000-0  空白   (1)    (1)    空白  3月   空白   空白  空白 {4} C  GGG    010   空白   (3)    (4)    空白  空白   空白 3月  7月 A~Cには氏名・住所・電話 がはいっており、D~Gには月がはいっており、H~Kには処理の名前が入っています。1行目は見出しです。 (H列以降、処理は増える可能性あり。) マクロで、(H2:KのlastRow = Cells(65536, "A").End(xlUp).Row)までに、その処理が何月に行われたかを入れたいのですが、 DEFGが(1)-(2)-(3)-(4) の場合、HIJK には1月-3月-7月-10月と入り、 DEFGが□-(1)-□-□ の場合、HIJK には3月-□-□-□と入り、 DEFGが□-(2)-□-□ の場合、HIJK には□-3月-□-□と入り、 DEFGが□-□-(4)-(4) の場合、HIJK には□-□-7月-□と入るようにマクロを組みたいのです。 (□は空白です。) 自分でも何度も組んでいるのですがエラーも出ずで、まったく動かず・・・ どなたかご教授ください。おねがいします!!!

  • VBA特定セルの値により、他のセルの値を変更する

    いつもお世話になっております。 以下のような表で・・・       {A}     {B}  {C}   {D}   {E}   {F}    {G}    {H}    {I}   {J}    {K} {1} 氏名  住所  電話   1月   3月   7月   10月   処理(1) 処理(2) 処理(3) 処理(4)    {2} A     XXX  000-00  (1)   (2)   (3)    (4)   1月   3月   7月  10月 {3} B  TTT    000-0  空白   (1)    (1)    空白  3月   空白   空白  空白 {4} C  GGG    010   空白   (3)    (4)    空白  空白   空白 3月  7月 A~Cには氏名・住所・電話 がはいっており、D~Gには月がはいっており、H~Kには処理の名前が入っています。1行目は見出しです。 (H列以降、処理は増える可能性あり。) マクロで、(H2:KのlastRow = Cells(65536, "A").End(xlUp).Row)までに、その処理が何月に行われたかを入れたいのですが、 DEFGが(1)-(2)-(3)-(4) の場合、HIJK には1月-3月-7月-10月と入り、 DEFGが□-(1)-□-□ の場合、HIJK には3月-□-□-□と入り、 DEFGが□-(2)-□-□ の場合、HIJK には□-3月-□-□と入り、 DEFGが□-□-(4)-(4) の場合、HIJK には□-□-7月-□と入るようにマクロを組みたいのです。 (□は空白です。) 自分でも何度も組んでいるのですがエラーも出ずで、まったく動かず・・・ どなたかご教授ください。おねがいします!!!

  • エクセルVBA フォーム上でOnkeyがうまく出来ない

    エクセルVBAでプログラムをしています。 Application.Onkeyでショートカットを指定したいのですがフォーム上ではうまく指定できません。 フォーム上での指定は不可能なんでしょうか? ショートカットを認識するケース 標準モジュールに Sub test2() MsgBox "test2" End Sub Sub Auto_Open() Application.OnKey "{b}", "test2" End Sub としてシート上で「b」を押した場合はうまくいきます。 ショートカットを認識しないケース 標準モジュールに Sub test() MsgBox "test" End Sub UserForm1フォームに Private Sub UserForm_Initialize() Application.OnKey "{a}", "test" End Sub としてフォームをロード(表示)して「a」を押しても何もおきません。 またフォームが表示されている状態で「b」を押しても何もおきません。 上記のコードはテストで作ったものなのでこれ以外はフォームを開く文以外何も書いておりませんので他との兼ね合いではないと思います。 どうすれば思ったとおりの動作になるのでしょうか? そもそもOnkeyはユーザフォームがアクティブのときは動かないのでしょうか? 動かない場合、フォームがアクティブなときのみフォームごとに違う関数を呼ぶショートカットを作る方法はありませんでしょうか? (コントロールごとにkey_downイベントで確認する方法はコントロールの数が各100個ほどあるのと、フォームが10個以上あるため出来ればやりたくありません。) 環境はwinXP、excel2003です。 よろしくお願いいたします。

  • VBA 配列から配列に

    3×3の2次元配列から(1,1)(1,2)(1,3)、(3,1)(3,2)(3,3)を別の配列に入れなおしたいのですが、(1,1)を入れて、(1,2)を入れて、(1,3)を入れるという入れ方ではなく、(1,1)(1,2)(1,3)を1コードで入れることは可能でしょうか。

  • Excelのデータをデータベースで使用できる形に変換

    現在、excelでシフト表があります。 これをMYSQLにインポートをしようと思うのですが、 データの変換方法が分かりません。 現在のデータはA列に社員ID 1行目に1月分の日付が入っていて、 出勤可能を1、出勤不可を2 出勤決定を3で入力されてます。 分かりずらいかもしれませんが、下記のような表になります。   2008/7/1 2008/7/2 2008/7/3 2008/7/4 ・・・ 001  1    2     1    2 002  2    3     1    2 003  1    1     3    2 004  1    2     2    2 ・ ・ これを 001  1 2008/7/1 001  2 2008/7/2 001  1 2008/7/3 001  2 2008/7/4 002  2 2008/7/1 002  3 2008/7/2 002  1 2008/7/3 002  2 2008/7/4 ・ ・ ・ という1行1レコードの形式に変換したいと思います。 従業員数が数百人になるので、一度に変換できる方法が無いかと思い質問させていただきました。 どうかよろしくお願いいたします。

  • EXCELVBAにおけるピボットテーブルについて

    EXCELVBAにおけるピボットテーブルについて、 詳しく学べるサイトを、かれこれ2時間ほど探してますが一向にみつかりません…。 どなたかご存じありませんでしょうか? よろしくお願いいたします。

  • エクセルの画像貼り付けマクロについて

    Sub 画像挿入() ActiveSheet.Unprotect Password:="pass" Application.Dialogs(xlDialogInsertPicture).Show If Dialog1.Show Then With ActiveSheet.Pictures(1) .Top = Range("D31").Top .Left = Range("D31").Top Selection.ShapeRange.IncrementLeft -126# Selection.ShapeRange.IncrementTop 21.75 End With ActiveSheet.Protect Password:="pass", DrawingObjects:=True, _ contents:=True, UserInterfaceOnly:=True End Sub 現在、ダイアログ表示で画像を貼り付けられるように設定しています。 2点質問があり、お答えしていただければと思います。 まず、ダイアログ表示時にキャンセルを押した場合エラーメッセージが 出てきますので、キャンセルを押した場合にダイアログが閉じるように 設定する。 2点目が、間違えて貼り付けてしまった画像を削除する事。 保護をマクロの後にしますので、貼り付けてしまったらその画像を 選択して削除が出来ません。 削除ボタンで貼り付けた画像を削除したいのですがいい方法は ございますでしょうか? 緊急ですのでどなたかお答え頂けますでしょうか、よろしくお願い致します。

  • VBA【dictionary勉強中ですが・・・】集計マクロ

    いつもお世話になっております。 現在dictionary勉強中ですが、なかなかコツをつかめず 思ったとおりのマクロを作成することができません(ノ_;) ところで、今回作成しているのは 元データ.xlsというファイルのシート(データ)に   |【A】| B | C |【D】| E | F |・・・|H|I|【J】|K 3  【顧客ID】|顧客|受付日|【担当】|・・・|【会場名】|(見出し) 4  データの始まり↓ と、ありまして、 集計データ.xlsのシート(集計)に  | A | B | C | D | E | F | 1 顧客ID|担当|会場名| と二行目から一覧表があります。 A列のIDが一致するものに Sheet(データ)  →  Sheet(集計)  セル( i, "D")の値 → セル( j, "B") に セル( i, "J")の値 → セル( j, "C")に     セル(j,"C")に値が入っているとき、セル(j,"D")に→Fまで(4回のみ) A列のIDが一致するものがない時 セル( i, "A")の値 → セル( 最終,"A")に  セル( i, "D")の値 → セル( 最終, "B") に セル( i, "J")の値 → セル( 最終,"C")に追加 というように、入れたいのですが、 以下のようなコードをネットで見つけ自分なりに考えて変更を加えてみましたが あまり分かっていないためどのように変更すればいいのかよく分かりません。どなたかご教授ください。お願いします。 Sub Try() Dim data_1() As String Dim data As Long Dim maxrow As Long Dim t As Integer, f As Integer, y As Integer Set ws1 = Worksheets("集計") Set ws2 = Worksheets("データ") Application.ScreenUpdating = False maxrow = ws2.Range("a65536").End(xlUp).Row With ws1 For i = 2 To Range("a65536").End(xlUp).Row data = .Cells(i, 1) f = 0 t = 0 With ws2 t = Application.WorksheetFunction.CountIf(.Range("a4:a" & maxrow), data) If t > 0 Then For n = 1 To maxrow ReDim Preserve data_1(f) If data = .Cells(n, 1) Then data_1(f) = .Cells(n, 10) f = f + 1 If t = f Then Exit For Else 'A列にIDが存在しなければ追加する:ここの記述がよく分かりません。 data_1(f) = .Cells(n, 1) End If Next n For y = 0 To UBound(data_1) ws1.Cells(i, maxcol(i)) = data_1(y) Next y End If End With Next i End With Application.ScreenUpdating = True End Sub '-------------------------- Private Function maxcol(ByVal i As Long) As Integer Dim j As Integer With Worksheets("集計") j = 4 Do While .Cells(i, j) <> "" j = j + 1 Loop maxcol = j End With End Function