- ベストアンサー
数行ごとの折り返しについて
このようなマクロを作りました。 ------------------------------------------------ Dim i As Integer, r As Range With Worksheets("リスト") .Hyperlinks.Delete .Range("B4:B65536").ClearContents For i = 2 To Worksheets.Count Set r = .Cells(i + 2, 2) r.Value = Worksheets(i).Name .Hyperlinks.Add Anchor:=r, Address:="", _ SubAddress:=Worksheets(i).Name & "!A1" Next i End With ------------------------------------------------ これだけでは、B列に並んでしまうだけなのでこれを20データごと次の列に入力できるようにしたいのですがいろいろ調べたのですがわかりませんでした。 わかる方がいましたらよろしくお願いします。
- みんなの回答 （2）
- 専門家の回答
関連するQ&A
- EXCELでのリスト作成について
このサイトでこのようなマクロを教えてもらいました。 そこでこれはシートの左側からリストシートに表示していくのですが、右側からリストにしていく方法はないでしょうか？ よろしくお願いします。 ------------------------- Sub テスト() ActiveWindow.WindowState = xlNormal Dim i As Integer, r As Range With Worksheets("リスト") .Hyperlinks.Delete .Range("B4:B65536").ClearContents For i = 2 To Worksheets.Count Set r = .Cells(((i - 2) Mod 20) + 4, 2 + Int((i - 2) / 20)) r.Value = Worksheets(i).Name .Hyperlinks.Add Anchor:=r, Address:="", _ SubAddress:=Worksheets(i).Name & "!A1" Next i End With Columns("B:B").EntireColumn.AutoFit End Sub -------------------------
- ベストアンサー
- オフィス系ソフト
- ハイパーリンクがうまくできません。
エクセルのマクロを使って、ハイパーリンクで同じブック内のシートに飛べるようなものをつくりたいと思っています。 まず、「全体」というシートに目次みたいに各シートのタイトルが書かれたページがあり、 そのタイトルがシート名になったものが大量にあります。 「全体」シートのタイトルをクリックするとそのシートに飛べるようにしたいのですがうまくいきません。 下のマクロはネットで探して使えると思ったものなのですが、 リンクをクリックしても「参照できません」とでて目的のシートに飛ぶことができません。 助言のほどよろしくお願いします。 Sub link123() Dim ws As Worksheet, r As Range With Worksheets("全体") For Each ws In Worksheets Set r = .Cells.Find(ws.Name, after:=.Range("A1"), LookAt:=xlWhole) If Not r Is Nothing Then .Hyperlinks.Add Anchor:=r, Address:="", SubAddress:=ws.Name & "!A1" End If Next ws End With End Sub
- ベストアンサー
- Visual Basic
- ExcelVBA一致しない場合その他の行に集計する
「ExcelVBA複数条件一致後別シートに結果表示」という質問を以前させていただき、丁寧にコードを解説していただきました。 ※その節はありがとうございました。 ●ファイルの内容(概要)配下の通りの構成です。 ＜Sheet1＞ A列：性別(男性:1、女性:2でコード化) B列：死因コード(数値5～6桁) C列：年齢 D列：市町村(3桁でコード化「201」等) ＜Sheet2＞Sheet1で条件に一致したものを以下の通り表を作成する ・「セルA1」に表にしたい市町村コードをあらかじめ入力しておく ・セルB1～セルEC1まで死因コード ・セルA2～セルA132まで年齢0～130 ・セル範囲B2～EC132に「A1」に入力した市町村コードの男性の値が入る ・セルB133～セルEC133まで死因コード ・セルA134～A264まで年齢0～130 ・セル範囲B134～EC264に「A1」に入力した市町村コードの女性の値が入る そして、以下のコードを教えていただきました。 **************************************************** Dim r As Long Dim i As Integer, j As Integer, k As Integer Dim Wsf As Object Dim SCode As Range, Nenrei As Range Dim Ws1 As Worksheet, Ws2 As Worksheet Set Ws1 = Worksheets("sheet1") Set Ws2 = Worksheets("sheet2") Set Wsf = Application.WorksheetFunction Application.ScreenUpdating = False Ws2.Range(Ws2.Cells(2, 2), Ws2.Cells(132, 133)).ClearContents Ws2.Range(Ws2.Cells(134, 2), Ws2.Cells(264, 133)).ClearContents With Ws2 Set SCode = .Range(.Cells(1, 1), .Cells(1, 133)) ↑ここはこのように書いていただいたのから、 指定の死因分類があったためシートから参照するようコードを変えています。 手元にファイルが無くてかけないのが初心者の情けないところです。 申し訳ありません。※シートは同一ファイル内におくようにしています。 End With r = 2 Do While Ws1.Cells(r, 1).Value <> "" If Ws1.Cells(r, 4).Value = Ws2.Cells(1, 1).Value Then If Ws1.Cells(r, 1).Value = 1 Then i = 1 ElseIf Ws1.Cells(r, 1).Value = 2 Then i = 134 End If With Ws2 Set Nenrei = .Range(.Cells(i, 1), .Cells(i + 130, 1)) End With j = i + Wsf.Match(Ws1.Cells(r, 3).Value, Nenrei, 0) - 1 k = Wsf.Match(Ws1.Cells(r, 2).Value, SCode, 0) Ws2.Cells(j, k).Value = Ws2.Cells(j, k).Value + 1 Else End If r = r + 1 Loop Application.ScreenUpdating = True Set Scode = Nothing Set Nenrei = Nothing Set Wsf = Nothing Set Ws1 = Nothing Set Ws2 = Nothing End Sub **************************************************** 表はあらかじめ作成しておくので、そこに集計結果が入ります。 実行していたら、古いファイルに不詳の死因コードが登場し、 どうしたらいいかと考えた結果、死因コードの列の最後に「その他」を設け、 死因コードに一致しない場合にはそこに集計結果をカウントすることは できないか？という考えに至りました。 自分で考えるのが一番勉強になると分かっていても試行錯誤している時間が無く、 急ぎのためお知恵のある方々にご協力を頂ければと思い、 再度質問させていただいた次第です。 前の質問は↓こちらです。 http://okwave.jp/qa/q8356291.html 何卒よろしくお願い申し上げます。
- ベストアンサー
- Visual Basic
- マクロが上手く組めない
各シートの特定のセル(1,25)にINDEXシートのハイパーリンクを 設定したいのですが、「オブジェクトが存在しません」 とエラーが表示されてしまっており、どのように修正すればいいのか 分からず、困っております。何故エラーが出たのかについてご教授頂けると幸いです。 私の書いたソースコード ********************************** ********************************** Sub INDEXLINK() Dim w As Worksheet Set w = Sheets("INDEX") Dim i As Long For i = 1 To ActiveWorkbook.Worksheets.Count Worksheets(i).Hyperlinks.Add Anchor:=Worksheets(i).Cells(1,25), Address:="", SubAddress:=w & "!c1", TextToDisplay:=w.Name Next End Sub
- ベストアンサー
- Visual Basic
- インデックスが有効範囲に出ないと出る
下記のようなVBAを書きました。しかしインデックスが有効範囲にないとメッセージがでるのですが、どこがまちがっているでしょうか？？ Sub macro1() Dim i As Long Dim r As Long Worksheets("フェアリスト ").Select Worksheets("csv").Range("A:C").ClearContents For i = 2 To 50 Step 5 If Worksheets("フェアリスト").Cells(11, i + 1) <> "" Then r = Worksheets("フェアリスト").Cells(65536, i + 1).End(xlUp).Row Worksheets("フェアリスト").Range(Cells(11, i), Cells(r, i + 3)).Copy _ Destination:=Worksheets("csv").Range("B65536").End(xlUp).Offset(1) Worksheets("csv").Range("A65536").End(xlUp).Offset(1).Resize(r - 3, 1).Value = Worksheets("フェアリスト").Cells(8, i).Value End If Next i Worksheets("csv").Range("A1:C1").Delete shift:=xlShiftUp End Sub
- ベストアンサー
- オフィス系ソフト
- セルの値でなくセルの関数を参照したい
次のコードでセルI13の値を入力できましたが、 '---------------------- 'Dim i As Integer 'For i = 2 To Worksheets.Count - 6 'With Worksheets(i) '.Range("I13") = Worksheets(1).Range("I13").Value 'End With 'Next セルの値でなく関数を入力しようとして次のコードに修正したらエラーになりました。どこがいけないのでしょうか。 Dim i As Integer For i = 2 To Worksheets.Count - 6 With Worksheets(i) .Range("I13").Formula = "=" & Worksheets(1).Name & "!I13" End With Next
- ベストアンサー
- Visual Basic
- VBA【初歩的な質問】
エクセルシートのA列にホームページの名前、B列にそのページのアドレスが入力されております。 A列のページ名にハイパーリンクの情報を結び付けて、B列を削除したいです。 ※A列の名前が青くなっていて、クリックするとそのページに飛んでいくことができて、B列は空白 そのVBAを教えて頂けると助かります。 ページによって最終行が異なるので、最初に最終行を出して、For i で繰り替えしたらいいのでしょうか？ HYPERLINKS.Addメソッドというのを使えばいいと思ったんですが、うまくいきませんでした。 Option Explicit Sub Sample() Dim i As Long '1行目からA列の最終行まで繰り返す For i = 1 To Range("A" & Rows.Count).End(xlUp).Row With ActiveSheet.Hyperlinks .Add Anchor:= End With Next i End Sub
- ベストアンサー
- Visual Basic
- マクロ FIND 検索方向の変更
いつも回答ありがとうございます。 FINDを使用した検索方向の変更についての質問です。以下のFINDの記述方法で、上から一発目に捉えられたキーワードではなく、下から一発目に捉えられたキーワードに変更するにはどうしたらよろしいでしょうか？それとも、FINDの記述方法を大幅に変えなければいけないのでしょうか？御指導の程宜しくお願い致します。 Sub TEST() Dim d As Integer Dim e As Integer Worksheets("一覧").Activate d = 3 e = 3 Do While Worksheets("一覧").Cells(d, 2).Value <> "" Dim c As Variant Dim R As Range Dim s As Range With Worksheets(Worksheets("一覧").Cells(d, 2).Value) Set c = .Columns("H").Find("増", , xlValues, 1) If Not c Is Nothing Then Set R = .Range(c.Offset(1, -4), .Cells(Rows.Count, "D").End(xlUp)) Set s = c.Offset(, -5) With Worksheets("編集用一覧") .Range(.Cells(e, 4), .Cells(e, 5)).ClearContents .Cells(e, 4).Value = s .Cells(e, 5).Value = Application.Sum(R) End With End If End With d = d + 1 e = e + 4 Loop End Sub
- ベストアンサー
- オフィス系ソフト
- Excel２０００マクロ記述の変更について
下記のマクロを記述しています。 条件が変わったので変更したいのですが、変更の記述の仕方を 教えてください。 現在の条件 If (.Range("D" & i) = "A310" Or .Range("D" & i) = "A505") And .Range("V" & i) <= 1000 変更の条件 倉庫マスタ（シート名）のＢ列の５行目以降とＡＣＴ（シート名）のＤ列の６行目以降を参照して同じデータで、倉庫マスタのＧ列の５行目に記号が入っている場合は、ＡＣＴ（シート名）の６行目からに 下記の条件を設定したい。 .Cells(i, "M").ClearContents .Cells(i, "O").Resize(1, 15).ClearContents Sub 再表示1() Dim SheetName As String Dim i As Integer Dim LastRow As Integer Dim rng As Range SheetName = "ＡＣＴ" 'シート名 LastRow = 3000 '最終行の番号 With Sheets(SheetName) Sheets("ＡＣＴ").Select For i = 6 To LastRow If (.Range("D" & i) = "A310" Or .Range("D" & i) = "A505") And .Range("V" & i) <= 1000 Then .Cells(i, "M").ClearContents '原料平均データ消去 .Cells(i, "O").Resize(1, 15).ClearContents '前月末在庫～発注後在庫欄までデータを消去 End If Next End With End Sub
- ベストアンサー
- オフィス系ソフト
- VBAデータ元から新規ブックに出力
現在のブック内に出力されるとメモリの都合上時間がかかりすぎますそこで新規ブック１個に出力する構文を教えていただきたいのですが、宜しくお願いします。 Sub １１１１() Dim c As Range Dim i As Integer, LastRow As Long Dim NewSheetName As String, MatchFlag As Boolean Application.ScreenUpdating = False NewSheetName = "" With Sheets("データ元") For Each c In .Range(.Cells(3, "B"), .Cells(Rows.Count, "B").End(xlUp)) MatchFlag = False If NewSheetName <> Year(c.Value2) & "年" & Month(c.Value2) & "月" Then NewSheetName = Year(c.Value2) & "年" & Month(c.Value2) & "月" For i = 1 To Worksheets.Count If Sheets(i).Name = NewSheetName Then Sheets(i).Cells.ClearContents MatchFlag = True Exit For End If Next i If MatchFlag = False Then Worksheets.Add after:=Worksheets(Worksheets.Count) ActiveSheet.Name = NewSheetName End If End If LastRow = Sheets(NewSheetName).Cells(Rows.Count, "A").End(xlUp).Row Sheets(NewSheetName).Cells(LastRow + 1, "A").Resize(1, 6).Value = .Cells(c.Row, "A").Resize(1, 6).Value Sheets(NewSheetName).Columns("A:F").EntireColumn.AutoFit '↑A列からF列まで自動幅調整してます Next .Activate End With Application.ScreenUpdating = True MsgBox "終了しました", vbInformation End Sub
- ベストアンサー
- Visual Basic
