Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


170 / 3841 ページ ←次へ | 前へ→

【79057】Re:VBAを用いて日付を自動判別して、その...
発言  マナ  - 17/4/22(土) 11:27 -

引用なし
パスワード
   ▼せいじ さん:

B2に、「川田」
C2に、「1/1」

だとして、これで、1人分のデータの転記です。


Sub test2()
  Dim ws転記 As Worksheet
  Dim 転記行 As Long
 
  Set ws転記 = Worksheets(Worksheets("入力フォーム").Range("B2").Value)

  転記行 = Day(Worksheets("入力フォーム").Range("C2").Value) + 1
  
  ws転記.Range("B" & 転記行 & ":D" & 転記行).Value = Worksheets("入力フォーム").Range("D2:F2").Value
 
End Sub


↓が転記でよく使わる構文です。

転記先.Value=転記元,Value

もちろん、

転記元,Copy 転記先

でもできます。

まずは、ここまで理解できますか。
・ツリー全体表示

【79056】Re:VBAを用いて日付を自動判別して、その...
発言  せいじ E-MAIL  - 17/4/22(土) 10:31 -

引用なし
パスワード
   返信ありがとうございます!
確認しました。

Dim ws入力 As Worksheet
  Dim ws転記 As Worksheet 
  Dim c As Range
  Dim 転記行 As Long
  
  Set ws入力 = Worksheets("入力フォーム")
  
  For Each c In ws入力.Range("B2", ws入力.Range("B" & Rows.Count).End(xlUp))
”入力フォームのB2セルからB列全てのセルから、Cを取出し”

    Set ws転記 = Nothing
”ws転記”のオブジェクト参照を解除(これは何のためでしょうか?)

    On Error Resume Next
    Set ws転記 = Worksheets(c.Value)
    On Error GoTo 0
”ws転記を変数Cの値のワークシートとする”(すいません、わからないです。)
”エラー発生時には以下より再開する”

    If Not ws転記 Is Nothing Then
”ws転記がnothingでなかったら”(入力があったらという意味?)

      転記行 = Day(c.Offset(, 1).Value) + 1
”変数Cの一つ右のセルの値に1を足す(この場合は日付ですね)

      ws転記.Range("B" & 転記行).Resize(, 3).Value = c.Offset(, 2).Resize(, 3).Value
”ws転記のB列と変数転記行の・・・
(このコード意味は理解できませんでした。)
    
End If
  Next
  
End Sub

ここで変数Cはどのように代入するのでしょうか?
VBA知識が足りず申し訳ございません。
色々と調べたのですがわかりませんでした。
・ツリー全体表示

【79055】Re:VBAを用いて日付を自動判別して、その...
発言  マナ  - 17/4/21(金) 21:01 -

引用なし
パスワード
   ▼せいじ さん:

何をしているかわかりますか


Option Explicit

Sub test()
  Dim ws入力 As Worksheet
  Dim ws転記 As Worksheet
  Dim c As Range
  Dim 転記行 As Long
  
  Set ws入力 = Worksheets("入力フォーム")
  
  For Each c In ws入力.Range("B2", ws入力.Range("B" & Rows.Count).End(xlUp))
    Set ws転記 = Nothing
    On Error Resume Next
    Set ws転記 = Worksheets(c.Value)
    On Error GoTo 0
    If Not ws転記 Is Nothing Then
      転記行 = Day(c.Offset(, 1).Value) + 1
      ws転記.Range("B" & 転記行).Resize(, 3).Value = c.Offset(, 2).Resize(, 3).Value
    End If
  Next
  
End Sub
・ツリー全体表示

【79054】Re:VBAを用いて日付を自動判別して、その...
発言  せいじ  - 17/4/21(金) 20:29 -

引用なし
パスワード
   ご指摘の通り右のセルです、すいません!

ボタンの件ですがこちらもご指摘の通り、
本当は入力したものがそれぞれの担当者ごとの
シートに一括で転記されるのが望ましいのですが、
そうすると、worksheetもfindメソッドで探さなければ
ならなくなり、私のスキルでは無理そうなので、
とりあえず一担当者毎に作ろうと思いまして。
・ツリー全体表示

【79053】Re:VBAを用いて日付を自動判別して、その...
発言  マナ  - 17/4/21(金) 18:59 -

引用なし
パスワード
   ▼せいじ さん:

>見つかったセルの一つ左のセルに貼り付け

左ではなく、右では?

-------
本題と関係ないですが…

人数分ボタンを用意しようとしていませんか。
一人ずつ転記するなら、入力フォームは1行分あればよいのでは?
まとめて転記するなら、ボタンは一つでよいのでは?

と思ってしまいます。
・ツリー全体表示

【79052】Re:VBAを用いて日付を自動判別して、その...
発言  せいじ E-MAIL  - 17/4/21(金) 16:49 -

引用なし
パスワード
   早速の回答ありがとうございました。
私の質問の方法がわかりくかったので例を出しながら書いてみます。

現在作っているのは出勤表です。
シート1では前日の勤務内容・売上金額等を担当者毎に入力します。
シート2以降では各担当者の当該月の出勤状況が見られるようにします。

シート1に入力された内容はマクロボタンを押すと、シート2の該当箇所に
転記されるようなVBAを組みたいと思っています。

(シート1例)
           日付  勤務時間  現場  売上
担当者名:川田  1/1  8時〜5時  町田市 150,000   ボタン
担当者名:田中  1/1  8時〜5時  日野市 100,000   ボタン

*出勤表入力は毎日行います。その為日付は毎日変わります。

(シート2例)
日付  勤務時間  現場  売上
1/1 
1/2
1/3
1/4
.
.
.
.

*予め、日付だけは入力しておきます。

以上のようなシートを用意しておきます。
シート1の内容を各担当者のシートに転記するのは簡単ですが、
問題はどの列に転記するかということになります。
そこで基準となるのが日付です。シート1に入力された日付を自動で判別して
シート2の該当する日付の横に内容を転記するVBAを作成したいのです。
たとえば上記の例だと、シート1の入力フォームには1/1となっているので、
シート2の1/1の横に転記され、翌日1/2に入力すればシート2の1/2の横に
転記されるようなものです。
以下に作成途中のコードを記載します。

sub test35 ()
dim rng as range  ←勤務時間・現場・売上の内容を変数にします。
dim dat as date   ←シート1の日付を変数にします。
dim rng2 as range  ←シート2の日付列を変数にします。

set rng = range(勤務時間〜売上のセル範囲)
set dat = range(シート1の日付のセル)
set rng2 = Range("シート2日付列").Find(What:=dat)

rng.copy Destination:=worksheet("川田").rng2.offset(0,-1)

勤務時間以下の内容をコピーして、川田シートのfindメソッドで見つかったセルの
一つ左のセルに貼り付け

…でうまくいきませんでした。
そもそもの考え方が間違っているのでしょうか?

長くなってしまい申し訳ございません。
もしお助けいただけるのであれは、よろしくお願いいたします!
・ツリー全体表示

【79051】Re:行単位の値検索
お礼  xder  - 17/4/21(金) 15:25 -

引用なし
パスワード
   ▼β さん:
回答ありがとうございます。いただいた関数で試してみたら確かにできました。
今後は質問前にもう少し勉強するようにします。
・ツリー全体表示

【79050】Re:行単位の値検索
発言  β  - 17/4/21(金) 15:08 -

引用なし
パスワード
   ▼xder さん:

マクロでですか?

A2 : =IFERROR(INDEX($D$1:$F$1,MATCH(A$1,$D2:$F2,0)),"")
これを C2 までフィルコピーして、そのまま下にフィルコピーでもできそうですが。
・ツリー全体表示

【79049】行単位の値検索
質問  xder  - 17/4/21(金) 14:33 -

引用なし
パスワード
   D2〜F5にaa、bb、ccという値がランダムに入力されており、
A2からC5に、A1〜C1が存在するD1〜F1の値をセットしたいのです。
お手数ですがご教示をお願いいたします。


| A列 B列 C列 D列 E列 F列
-|-------------------------------
1| aa  bb  cc  あ  い  う
|
2|        aa  bb
|
3|           bb  cc
|
4|        aa  bb
|
5|           cc


       ↓

| A列 B列 C列 D列 E列 F列
-|-------------------------------
1| aa  bb  cc  あ  い  う
|
2| あ  い    aa  bb
|
3|   い  う    bb  cc
|
4| あ  い    aa  bb
|
5|      い     cc
・ツリー全体表示

【79048】Re:VBAを用いて日付を自動判別して、その...
発言  マナ  - 17/4/20(木) 20:10 -

引用なし
パスワード
   ▼せいじ さん:

こんな感じでしょうか

set f=Sheets("sheet2").Columns(1).find(…
f.offset(,1).value=…
とか
f.entirerow.range("b1").value=…

-------

findのかわりに、matchでもよいです

m=application.match(…
Sheets("sheet2").cells(m, "b").value=…

------
あるいは、日付なら、検索しなくても行番号がわかるのでは?
2行目から日付がはじまるなら、こんな感じで。
r=Day(日付)+1
Sheets("sheet2").cells(r, "b").value=…
・ツリー全体表示

【79047】VBAを用いて日付を自動判別して、その横...
質問  せいじ E-MAIL  - 17/4/20(木) 14:12 -

引用なし
パスワード
   エクセルのVBAについての質問です。
シート1を入力フォームとして使用します。
シート2に入力フォームの内容を転記します。

入力フォームには

日付:内容1:内容2:・・・・

といった形で入力していきます。

シート2には

日付:内容1:内容2:・・・・
日付:内容1:内容2:・・・・



(1か月分)
といったフォームを予め用意してあります。

入力フォームで入力した内容をシート2に転記したいのですが、
その際に、日付を自動判別してシート2の該当日付の内容に転記できるよう
VBAを組みたいと思っています。

使用するメソッドはfindメソッドでいいと思うのですが、findメソッドで
判別したセルの横をselectする方法がわかりません。

わかる方がいらっしゃれば教えて頂きたい思います。
よろしくお願いいたします。
・ツリー全体表示

【79046】Re:BITMAPINFOHEADER とは?
回答  亀マスター  - 17/4/19(水) 21:58 -

引用なし
パスワード
   >コンパイルエラー、ユーザ定義型は定義されていません。、とでます。

エラーメッセージのとおりです。
BITMAPINFOHEADERという変数の型はVBAで用意されておらず、
だったらユーザが独自に宣言したユーザ定義型ということになるが、
その宣言部分が記述されていないので何のことかわかりませんよ、という意味です。

参考にしたサイトのコード例の中で、エラーになった箇所の上の方に
Private Type BITMAPINFOHEADER (Privateはないかもしれません)
で始まる部分がありませんか?そこから End Typeまでが
ユーザ定義型の宣言部分です。
・ツリー全体表示

【79045】Re:BITMAPINFOHEADER とは?
発言  γ  - 17/4/19(水) 21:55 -

引用なし
パスワード
   > HPにある例
ということでしたら、その記事を良く読んで下さい。
その型が定義されているはずです。

# VBA初心者には難しすぎることをされようとしているように思います。
# ステップを踏んで学習されたほうがよいと思います。
・ツリー全体表示

【79044】BITMAPINFOHEADER とは?
質問  KEN  - 17/4/19(水) 21:43 -

引用なし
パスワード
   VBA初心者です
二値化するマクロを作りたく、HPにある例をそのまま使って実行させましたが、
「Dim bmi As BITMAPINFOHEADER」のところで
コンパイルエラー、ユーザ定義型は定義されていません。、とでます。
手入力でもBITMAPINFOHEADERは出てきません。
office2013にはこの関数はないのでしょうか。
・ツリー全体表示

【79043】Re:チェックボックスがONの場合に選択し...
発言  β  - 17/4/19(水) 17:07 -

引用なし
パスワード
   ▼ペーターパン さん:

もう、ご覧にならないかもしれませんが。

そういうことだったんですか。
要件をすっかり誤解していました。

であれば、以下の2つの方法が考えられます。

1.任意の行が選択されたときに、その時点のチェックボックスの選択の状態をみて
 チェックが入っていたら、選択された行を太字にする。

 チェックボックスにはマクロ登録をしません。していれば消してください。
 で、シートモジュールに。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Cells.Font.Bold = False
  If CheckBoxes("チェック 1").Value = xlOn Then  '★
    Selection.EntireRow.Font.Bold = True
  End If
End Sub

 ★のところ、実際のコントロール名に直してください。

2.チェックボックスにチェックが入った時点で、その時に選択されていた行を太字にする。
 (これは、やってみると、操作が面倒というか、スムーズじゃないなと思いましたが)

 シートモジュールは使いません。記述があれば消してください。
 標準モジュールに以下のマクロを書き、チェックボックスにマクロ登録します。

Sub Test()
  Cells.Font.Bold = False
  If ActiveSheet.CheckBoxes(Application.Caller).Value = xlOn Then Selection.EntireRow.Font.Bold = True
End Sub
・ツリー全体表示

【79042】Re:チェックボックスがONの場合に選択し...
お礼  ペーターパン  - 17/4/19(水) 14:42 -

引用なし
パスワード
   ▼β さん:
いろいろとご教示頂きありがとうございました。
自分の知識の浅さが分かりました。
本来やりたかったことはチェックボックスをONにしている間、選択している任意の行全てが太字になるようにしたかったのです。
あれから試行錯誤していますが、今回は断念することにしました。
諦めずにコツコツと経験を積み重ねてレベルアップと深く正確な知識の習得に励みます。
ご尽力頂きありがとうございました。


>▼ペーターパン さん:
>
> 
>▼ペーターパン さん:
>
>全く別のポイントで。
>
>太字にしたり通常にしたり、そういったことを行う行が何行あるのかわかりませんが
>そのすべての行にチェックボックスを配置するのも大変ではないですか。
>
>しかもチェックボックスを、『正確に』その行の中におさめなければいけません。
>ちょっと上にずれたりすることって無きにしも非ず。
>操作者がうっかりと右クリックで選択してずらしてしまうかもしれませんし。
>
>チェックボックス制御をやめ、たとえばフォントの状態をかえたい行の任意のセルを
>ダブルクリックして処理するということも考えられます。
>以下の例では、どの行に対しても操作可能ですが、もちろん、何行目以降とか何行目から
>何行目までの間とか、その行の特定の列に特定の文字が入っている行のみとか、
>そういった条件はいくらでもつけられます。
>
>シートモジュールに。
>
>Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
>  Cancel = True
>  Target.EntireRow.Font.Bold = Not Target.Font.Bold
>End Sub
・ツリー全体表示

【79041】Re:等間隔の行数取得
お礼  boss  - 17/4/18(火) 18:50 -

引用なし
パスワード
   ▼β さん:
▼γ さん:

お二方にご助言いただいた方法にて、試行錯誤して何とか結果が出せました!
色々勉強になり、本当にありがとうございました。
拙い説明であったりで、ご迷惑をお掛けいたしましたことお詫びいたします。
・ツリー全体表示

【79040】Re:等間隔の行数取得
発言  β  - 17/4/18(火) 13:37 -

引用なし
パスワード
   ▼boss さん:

Dictionary で制御する案も2つほどアップしておきます。

コードでは K列 13行目から最終行までの間で 7行ごとに処理しています。
Sample2,Sample3 、基本的に同じことをしているんですが、Sample2 のほうは
取得する あああ アドレスを Range("K13,K20,K27,・・・") といったようにしています。
この Range内のアドレス文字列が 255桁を超えるとエラーになります。

そういう心配があるなら、Sample2 のように該当のセルを1つずつ取り出して処理することが
必要になります。

Sub Sample2()
  Dim dic As Object
  Dim i As Long
  Dim mx As Long
  Dim sh1 As Worksheet
  Dim c As Range
  Dim g As Range
  
  Set sh1 = Sheets("Sheet1")
  Set dic = CreateObject("Scripting.Dictionary")
  mx = sh1.Range("K" & Rows.Count).End(xlUp).Row
  
  For i = 13 To mx Step 7
    Set c = sh1.Cells(i, "K")
    Select Case c.Value
      Case "最終": Set g = c
      Case "あああ": dic(c.Address(False, False)) = True
    End Select
  Next
  
  If g Is Nothing Then
    MsgBox "最終 がありません" & vbLf & "処理を打ち切ります"
  ElseIf dic.Count = 0 Then
    MsgBox "あああ がありません" & vbLf & "処理を打ち切ります"
  Else
    MsgBox "最終 は " & g.Address(External:=True) & vbLf & _
      "あああ は " & sh1.Range(Join(dic.keys, ",")).Address(External:=True)
  End If
  
End Sub

Sub Sample3()
  Dim dic As Object
  Dim i As Long
  Dim mx As Long
  Dim sh1 As Worksheet
  Dim c As Range
  Dim g As Range
  Dim d As Variant
  
  Set sh1 = Sheets("Sheet1")
  Set dic = CreateObject("Scripting.Dictionary")
  mx = sh1.Range("K" & Rows.Count).End(xlUp).Row
  
  For i = 13 To mx Step 7
    Set c = sh1.Cells(i, "K")
    Select Case c.Value
      Case "最終": Set g = c
      Case "あああ": Set dic(c.Address(False, False)) = c
    End Select
  Next
  
  If g Is Nothing Then
    MsgBox "最終 がありません" & vbLf & "処理を打ち切ります"
  ElseIf dic.Count = 0 Then
    MsgBox "あああ がありません" & vbLf & "処理を打ち切ります"
  Else
    MsgBox "最終 は " & g.Address(External:=True) & vbLf & _
          "いまから あああ のセルを1つずつ表示します"
    For Each d In dic.items
      MsgBox d.Address(External:=True)
    Next
    
  End If
  
End Sub


・ツリー全体表示

【79039】Re:等間隔の行数取得
発言  boss  - 17/4/18(火) 11:46 -

引用なし
パスワード
   ▼β さん:
ご助言ありがとうございます。βさんの助言を見る前に【79036】を記載してしまいました。
ご指摘の「要件」も不明瞭で仰るとおりです。申し訳ございません。
いただいたサンプルをもとに頑張ってみます。結果は後報いたします。
先ずは御礼です。
・ツリー全体表示

【79038】Re:等間隔の行数取得
発言  β  - 17/4/18(火) 11:12 -

引用なし
パスワード
   ▼boss さん:

参考になるかどうか K13 から K列データ最終セルまでの間の 
最終 と あああ のセルを取得するサンプルです。

等間隔 というところは無視しています。
ここで、取得される g や a の領域を相手に、好きな処理をどうぞ。
a は セルの集合体ですから、その中から1つずつ取り出して処理するのもよし
処理要件によっては a に対して一括処理もできるでしょう。

Sub Sample()
  Dim sh1 As Worksheet
  Dim g As Range
  Dim c As Range
  Dim f As Range
  Dim a As Range
  Dim ttlrow As Long
  Dim r As Range
  
  Set sh1 = Sheets("Sheet1")
  Set r = sh1.Range("K13", sh1.Range("K" & Rows.Count).End(xlUp))
  
  Set g = r.Find(What:="最終", LookAt:=xlWhole, SearchDirection:=xlPrevious)
  If g Is Nothing Then
    MsgBox "最終の行がありません" & vbLf & "処理を打ち切ります"
    Exit Sub
  End If
  
  ttlrow = g.Row
  
  MsgBox "最終は " & ttlrow & "行目にありましたよ"
  
  Set c = r.Find(What:="あああ", LookAt:=xlWhole, After:=r.Cells(r.Count))
  
  If c Is Nothing Then
    MsgBox "あああ の行がありません" & vbLf & "処理を打ち切ります"
    Exit Sub
  End If
  
  Set f = c
  
  Do
    If a Is Nothing Then
      Set a = c
    Else
      Set a = Union(a, c)
    End If
    
    Set c = r.FindNext(c)
    
  Loop While c.Address <> f.Address
  
  MsgBox "あああ は 以下に存在しています" & vbLf & a.Address(External:=True)
  
End Sub
・ツリー全体表示

170 / 3841 ページ ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free