利用規約の変更について

よろしくお願いします
いつもgooの皆さんに大変お世話になっています
エクセルは2013です

マクロで
「A1の値は、セル範囲でA1:AB39の値(文字列)の右端2文字が YR と書いてあるセルの右隣の値」
はどういうコードになるでしょうか

例えば セル D10 の値(文字列)が、「2月合計yr」でしたら
セル A1 には 右隣のセル E10 の値を表示したいのです

右2文字は Ucase(Right(セル,2)) ですが
「セル範囲A1:AB39で、そのセルの右端2文字がYRと書いてあるセルの右隣のセル」を
探す方法が分かりません

質問者からの補足コメント

  • タイトルに誤りがありましたので訂正させてください
    「右2文字」は正確には「右端2文字」です

      補足日時:2017/02/24 11:02
  • >明示的に書かせていただきます。

    マクロ初心者の私には、いつもコメントを書いていただいて
    その後の小さな変更に大変役立っています
    ありがとうございます

    No.1の回答に寄せられた補足コメントです。 補足日時:2017/02/24 11:24

このQ&Aに関連する最新のQ&A

A 回答 (1件)

本来、以下は省略して書くことが多いのですが、明示的に書かせていただきます。



Ucase(Right(セル,2)) ->MatchCase:=False
全角半角の違いは、MatchByte:=False
末尾のyr を探すのは、What:="*yr"  (LookAt:=xlWholeも必要)
現在のコードは1回限り After:=Range("A1") 続けるなら、ActiveCell

私は、ここのカテゴリでは、質問者さんから、答えだけ書いてりゃいいのだ、というので、みなさんから評判が悪いようです。
どなたかの回答をお待ちになっても良いかと思います。

'//
Sub SearchChars()
 Dim c As Range
 With Range("A1:AB39")
 Set c = .Find( _
  What:="*yr", _
  After:=Range("A1"), _
  LookIn:=xlValues, _
  LookAt:=xlWhole, _
  SearchOrder:=xlByRows, _
  MatchCase:=False, _
  MatchByte:=False)
    If Not c Is Nothing Then
     c.Offset(, 1).Value = Range("A1").Value
    End If
 End With
End Sub
'//
この回答への補足あり
    • good
    • 0
この回答へのお礼

WindFallerさん、こんにちは
早速教えていただきありがとうございます
いつも大変お世話になっています

c.Offset(, 1).Value = Range("A1").Value を
Range("A1").Value= c.Offset(, 1).Value に変えて
見事に私の狙ったことができました

このような高度なコードは私が何日考えても書けません
色々と応用の効くコードですね
大切に使わせていただきます

ありがとうございました
感謝いたします

お礼日時:2017/02/24 11:20

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aと関連する良く見られている質問

Q特定の文字から始まる文字を抜き出したい!

初めての書き込みます。
エクセル初心者でいろいろ調べましたが、応用力がなく行き詰まってしまいました。
詳しい方お力貸してください。


A1のセルに以下のように、ずらーっと入っているとします。

こんにちは 品番:AAAAAA おはよう 原産国:インドネシア さようなら 品番:BBBBBB おはよう 原産国:カンボジア・・・・・・・・・・・・・・・・・


例えば、ここから、品番から始まる10桁と原産国から始まる10桁を抜き出したい場合

=LEFT(RIGHT($A$1,(LEN($A$1)+1)-FIND("品 番:",$A$1)),10)

↑これで、抜き出しはできたのですが、繰り返し次の品番、原産国も抜き出していきたい場合はどのようにしたらよいのでしょうか??

どうぞお力貸してください。
宜しくお願いします。

Aベストアンサー

#6の回答者です。
補足をみました。

内容が変わっています。
原産国 ->生産国に変わっているので、それではエラーが発生してしまいます。

質問内容の、そのデータは、IE Document の innerText とかではないでしょうか。innerHTML のデータとか提示できませんか?もう少し、まともな切り分けが可能です。

それに、Table で取り出せば、そのまま表になって並ぶはずです。
今回のコードを、文字の規則に従って、さらに直すことは可能ですが、今の段階では、この程度でもよいのかと思います。

''------
Sub SplitWordsR()
 Dim str_text As String
 Dim i As Long
 Dim buf1, buf2, buft
 str_text = Range("A1").Value
 buf1 = Split(str_text, "品番")
 buf2 = Split(str_text, "生産国")
 If UBound(buf1) <> UBound(buf2) Then
  MsgBox "品番と生産国の数の対応がありません", vbExclamation
  If MsgBox("それでも続行しますか?", vbOKCancel) = vbCancel Then Exit Sub
 End If
 Range("A3:B3").Value = Array("品番", "生産国")
 For i = 0 To UBound(buf1)
 On Error Resume Next
  If Left(buf1(i), 1) Like ":" Then
   buft = buf1(i)
   Cells(3 + i, 1).Value = Mid(buft, 2, 7)
   ''Debug.Print buft
   Cells(3 + i, 2).Value = Mid(Split(buft, "生産国")(1), 2, 7)
   buft = ""
  End If
On Error GoTo 0
 Next
End Sub

#6の回答者です。
補足をみました。

内容が変わっています。
原産国 ->生産国に変わっているので、それではエラーが発生してしまいます。

質問内容の、そのデータは、IE Document の innerText とかではないでしょうか。innerHTML のデータとか提示できませんか?もう少し、まともな切り分けが可能です。

それに、Table で取り出せば、そのまま表になって並ぶはずです。
今回のコードを、文字の規則に従って、さらに直すことは可能ですが、今の段階では、この程度でもよいのかと思います。

''------
Sub Spl...続きを読む

QVBAでのシフト表の何日~何日までの求め方

同じ質問がありましたら申し訳ございません。
VBAに興味を持ち、関数より楽しく色々勉強している身なのですが、どなたかお力をお貸し下さい。

VBAでシフト表を作る際に、D3セルが「15」でAI3セルが「16」日までの日付を入力するにはどの様にプログラムを組めばよろしいのでしょうか?
例えばD3セルに2017/03/15と入力し横に自動で表示出来る様にしたいのです。
その際に月の28日、30日、31日の空いているセルが、動いた分削除される、シフト表を作成したいのです。
また日付の下のセルには関連付けで曜日を表示させたいです。
重ね、VBAでのシフト表を作る際に参考にした書籍などありましたらお教え下さい。

どうぞよろしくお願い致します。

Aベストアンサー

No11です。
>D2のセルから右へ祝日の日を表示させたいのですが可能でしょうか?
反映しました。カレンダー作成のマクロに組み込みました。
添付の図のように設定シートのC列に祝日名を記入しておく必要があります。

>またD8セルから右へその日の合計人数を。最後にそのD8セルの合計人数が3人の日に背景を赤になる表示をさせたいのです。
反映しました。勤務日数集計のマクロに組み込みました。

以下のようになります。前回のマクロを全て破棄し、こちらで入れ替えてください。
----------------------------------------
Option Explicit
Public Sub カレンダー作成()
Dim sh0 As Worksheet '設定シート
Dim sh1 As Worksheet 'シフト表シート
Dim s_date As Date '開始日
Dim e_date As Date '終了日
Dim col As Long '列
Dim wkday As Long '曜日(1:日~7:土)
Dim wdate As Date
Dim i As Long
Dim maxrow0 As Long
Dim maxrow1 As Long
Dim row0 As Long
Dim color As Long '日付・曜日の背景色
Set sh0 = Worksheets("設定")
Set sh1 = Worksheets("シフト表")
'開始日取得
s_date = sh0.Cells(2, "A").Value
'終了日計算
e_date = DateAdd("m", 1, s_date) - 1
maxrow0 = sh0.Cells(Rows.Count, "B").End(xlUp).row '設定 B列の最大行取得
maxrow1 = sh1.Cells(Rows.Count, "C").End(xlUp).row 'シフト表 C列の最大行取得
'カレンダークリア
sh1.Range("D2:AH" & maxrow1 + 1).Value = "" '祝日名/日/曜日
sh1.Range("D3:AH" & maxrow1 + 1).Interior.Pattern = xlNone '日/曜日の背景色
sh1.Range("AJ5:AJ" & maxrow1).Value = "" 'AJの勤務日数合計

'カレンダー作成
For i = 0 To (e_date - s_date)
col = 4 + i
wdate = s_date + i
wkday = Weekday(wdate)
sh1.Cells(3, col).Value = wdate '日付
sh1.Cells(4, col).Value = WeekdayName(wkday, True) '曜日
'土曜日は水色、日曜日は赤色、祝日には黄色を背景に設定する
'休日判定(祝日と土日が重なった場合は祝日優先)
color = -1
row0 = IsHoliday(wdate, sh0, maxrow0)
If row0 > 0 Then
'祝日の場合
color = 65535 '黄色
sh1.Cells(2, col).Value = sh0.Cells(row0, "C").Value '祝日名
Else
If wkday = 1 Then color = 255 '赤
If wkday = 7 Then color = 15773696 '水色
End If
If color <> -1 Then
sh1.Cells(3, col).Interior.color = color
sh1.Cells(4, col).Interior.color = color
End If
Next
MsgBox ("完了")
End Sub
'祝日判定
Private Function IsHoliday(ByVal wdate As Date, ByVal sh0 As Worksheet, ByVal maxrow0 As Long) As Long
Dim row As Long
IsHoliday = 0
For row = 2 To maxrow0
If sh0.Cells(row, "B").Value = wdate Then
IsHoliday = row
Exit Function
End If
Next
End Function
Public Sub 勤務日数集計()
Dim sh1 As Worksheet 'シフト表シート
Dim col As Long '列
Dim i As Long
Dim workcount As Long '勤務日数
Dim maxrow1 As Long
Dim row As Long
Set sh1 = Worksheets("シフト表")
maxrow1 = sh1.Cells(Rows.Count, "C").End(xlUp).row 'シフト表 C列の最大行取得
'勤務日数集計
For row = 5 To maxrow1
workcount = 0
For i = 0 To 30
col = 4 + i
If sh1.Cells(3, col).Value <> "" And sh1.Cells(row, col).Value <> "休" Then
workcount = workcount + 1
End If
Next
sh1.Cells(row, "AJ").Value = workcount
Next
'その日の合計人数
For i = 0 To 30
col = 4 + i
If sh1.Cells(3, col).Value = "" Then Exit For
workcount = 0
For row = 5 To maxrow1
If sh1.Cells(row, col).Value <> "休" Then
workcount = workcount + 1
End If
Next
sh1.Cells(maxrow1 + 1, col).Value = workcount
'3人が出勤の場合(全員が出勤の場合)
sh1.Cells(maxrow1 + 1, col).Interior.Pattern = xlNone
If workcount = maxrow1 - 5 + 1 Then
sh1.Cells(maxrow1 + 1, col).Interior.color = 255 '赤色
End If
Next
MsgBox ("完了")

End Sub
------------------------------------------------------

No11です。
>D2のセルから右へ祝日の日を表示させたいのですが可能でしょうか?
反映しました。カレンダー作成のマクロに組み込みました。
添付の図のように設定シートのC列に祝日名を記入しておく必要があります。

>またD8セルから右へその日の合計人数を。最後にそのD8セルの合計人数が3人の日に背景を赤になる表示をさせたいのです。
反映しました。勤務日数集計のマクロに組み込みました。

以下のようになります。前回のマクロを全て破棄し、こちらで入れ替えてください。
------------------------------...続きを読む

QExcel VBAについて質問します Set wb = Workbooks.Open(myFdr &

Excel VBAについて質問します

Set wb = Workbooks.Open(myFdr & "\" & fname) '開き,wbとする。
cnt = Worksheets.Count
For n = 1 To cnt
i = i + 1 'カウント
wb.Sheets(n).Range("A2").Copy mb.Sheets("Sheet1").Cells(i, "A") 'コピー
wb.Sheets(n).Range("D2").Copy mb.Sheets("Sheet1").Cells(i, "B") 'コピー
Next

この内容を値のコピーにするにはどうすれば良いでしょうか
よろしくお願いします。

Aベストアンサー

Open メソッドの前に、
Set mb = ThisWorkbooks
が必要です。

cnt = Worksheets.Count
実害はないけれども、
これは、cnt = wb.Worksheets.Count とします。

>値のコピーにするにはどうすれば良いでしょうか
コードを逆さまにすればよいです。

mb.Sheets("Sheet1").Cells(i, "A").Value = wb.Sheets(n).Range("A2").Value

Qエクセルの計算式について、可能か教えてください。

エクセルに関して、詳しくないので教えてください。

例えば、「0.5」という基準の数値があって、計算結果が0.5を満たない場合に、
それらの満たない数値は、基準の”0.5”に切り上げたいと思います。
この様な事をエクセルで行うことは可能でしょうか。

意味わかりづらいかもですが、お分かりの方教えて頂けないでしょうか。

Aベストアンサー

可能だと思います.
具体的にはどの様な計算処理を行っているのか分かりませんので,1つ例を考えてみます.
例えばA列のセルに何かしらの入力値があり,B列のセルにA列のセル値を参照して計算処理するとします.
(つまり質問文の計算結果とします)
その計算結果が0.5以上である場合には計算結果を表示し,それ以外では0.5を反映させればよいので,IF関数が使えます.

=IF(計算処理>=0.5,計算処理,0.5)

ただ,計算処理の中身があまりにも長いのであれば,作業セル(ここに取り敢えず計算結果を入れる)の様なものを用意しておいて,そこで条件式を反映させた方が良いと思います.

下の画像はA列が入力,B列が出力,D列が作業(計算結果)としたものです.
計算処理はA列の値×0.5としています.

Q至急なお願いで申し訳ございません。Excelマクロ教えて下さい。該当する値があったら、処理をさせる。

A列    B列   C列  D列  E列  F列    G列
1 2/10  20              リンゴ 
2 2/15   40              人参
3 2/16   30              ぶどう
4 2/18  50              なし
5 2/20   60              人参
6 2/21   70              みかん
7 2/22   80             ぶどう

※至急で申し訳ございません。
上のような表があるときに、EXCELのマクロを用いて処理をしたいですが、どのように行えばいいか構文がわかりません。教えてください。

F列に"人参"があったら、同じ行のB列のすぐ下の"30"から、すぐ上の"40"を減算しG列に入力させたいです。
また、別な行に"人参"がF列にあるたびに繰返し同じ行のB列のすぐ下の"70"から、すぐ上の"60"を減算しG列に入力を繰返し"人参"が現れるたびに処理させたいのですが、うまくいきません。各列のデータは1500行くらいです。
どなたか、ご教授願います。

A列    B列   C列  D列  E列  F列    G列
1 2/10  20              リンゴ 
2 2/15   40              人参
3 2/16   30              ぶどう
4 2/18  50              なし
5 2/20   60              人参
6 2/21   70              みかん
7 2/22   80          ...続きを読む

Aベストアンサー

こんにちは!

1500行程度であれば順にループさせてもそんなに時間は要しないと思います。
一例です。

Sub Sample1()
Dim i As Long
For i = 1 To Cells(Rows.Count, "F").End(xlUp).Row
If Cells(i, "F") = "人参" Then
Cells(i, "G") = Cells(i + 1, "B") - Cells(i, "B")
End If
Next i
End Sub

こんな感じではどうでしょうか?m(_ _)m

Q〖エクセル〗MOD関数で、小さな数字を大きな数字で割り算した場合が理解できません

GOOの皆様いつもありがとうございます。
例えば1を2で割り算した場合は、0.5ですが、
MODした場合、余りの数はなぜ1になるのですか?
簡単に説明して頂ける方はいらっしゃいますか・・・

Aベストアンサー

>補足
そのとおりですね。
その例で言えば、10を3で割った余りは1です。
では、余った1を3で割るとどうなりますか?
3で割れないから1余ったのですよね?
なら、余りは1のままです。
割られる数が割る数より小さい正の値であれば、商は0、余りは割られる数そのままです。

Qエクセル vba 色分け

例えば、セルA1に
宜しくお願いします。
とあり、
セルB1に
宜しくお願いします。吉村
とあった場合、A1から追加された文字列"吉村"だけをB1のセル内で青く着色する事はできますか?

おわかりになる方、何卒ご教示くださいm(__)m

Aベストアンサー

>追記以外はしませんので、AとBの差だけ色が変われば
それが,No.6なのですが・・・A1の文字数を数えて,A1の文字数の次以降を右端まで 青色

C列の値を使って,その文字数分を変更 とすると,下記のような感じでしょうか
'------------------------------
Sub test4()
Dim len_B As Long
Dim i As Long

For i = 1 To Cells(Rows.Count, "B").End(xlUp).Row
len_B = Len(Cells(i, "B"))
Cells(i, "B").Characters(len_B - Cells(i, "C") + 1).Font.Color = RGB(0, 0, 255)
Next i

End Sub
'---------------------------------
結局,No6と大差ないような気がしますが...
手作業でC列の値を修正する場合は使えますか

なお,”VBAを使用しない”で セルの文字の一部だけ色を変えるというのは,私の知る限りおそらく無理だと思います.
なので,C列の値を変更したら,必ずVBAを実行する必要があります.

>追記以外はしませんので、AとBの差だけ色が変われば
それが,No.6なのですが・・・A1の文字数を数えて,A1の文字数の次以降を右端まで 青色

C列の値を使って,その文字数分を変更 とすると,下記のような感じでしょうか
'------------------------------
Sub test4()
Dim len_B As Long
Dim i As Long

For i = 1 To Cells(Rows.Count, "B").End(xlUp).Row
len_B = Len(Cells(i, "B"))
Cells(i, "B").Characters(len_B - Cells(i, "C") + 1).Font.Color = RGB(0, 0, 255)
Next ...続きを読む

Qエクセルで困っています。教えてください。

例えばエクセルでA1にリンゴ、A2にブドウ、A3にミカンと入力します。
B4にはデータの入力規制でリンゴ、ブドウ、ミカンをリストで$A$1:$A$3で設定します。
このとき、リンゴを選択したらB1に黒丸、ブドウを選択したらB2に黒丸、ミカンを選択したらB3に黒丸とするためにはどうしたらよろしいでしょうか?
教えてください。
※尚、入力規制できるのはB4のみです。

Aベストアンサー

https://oshiete.goo.ne.jp/qa/9648904.html
と同じですよね?
今回は珍しくミスをしているみたいですが、
補足をつけばきちんとフォローしてくれる回答者さんです。
おそらくこの程度の変更なら、すぐに可能でしょう。

>ちなみに=IF(A1=B4,"●","")のB4のところをB列、例えばB4:B10までとかにする場合はまた違う関数を挿入するのですか?

『「A1=B4」はセルA1とセルB4が同じならば』という条件を示しています。
「B4:B10」は範囲を示していますので、「同じ」という条件は使えません。
私なら、「見つかれば」的な関数探して使用します。
=IF(COUNTIF(B4:B10,A1),"●","") 
B4:B10の範囲のA1の値を数える=あれば1以上になるので存在している
ただし本当に「見つかれば」なので、その指定範囲のどこにあっても適合することになります。
逆に、A1が空白の場合、B4:B10に1つでも空白があるとその空白を見つけたことになるので、B1に"●"が表示されます。

また、他にも使えそうな
「MATCH(A2,B4:B10,0) 」ですが、存在しない場合にこの関数自体がエラーになるので、IF文での条件には使えないようです。

これが、試行錯誤です。
確認してみてください。

https://oshiete.goo.ne.jp/qa/9648904.html
と同じですよね?
今回は珍しくミスをしているみたいですが、
補足をつけばきちんとフォローしてくれる回答者さんです。
おそらくこの程度の変更なら、すぐに可能でしょう。

>ちなみに=IF(A1=B4,"●","")のB4のところをB列、例えばB4:B10までとかにする場合はまた違う関数を挿入するのですか?

『「A1=B4」はセルA1とセルB4が同じならば』という条件を示しています。
「B4:B10」は範囲を示していますので、「同じ」という条件は使えません。
私なら、「見つかれば」...続きを読む

Qマクロを組んだエクセルのデータを別のエクセルにコピペしたことが原因で・・・

win7使用してます。以前に,アクティブセルの行と列に十文字のラインが入るようにネットで調べたマクロを入力してみました。そのせいなのだと思うのですが,そのデータを別のエクセルにコピペして使うのですが,そのコピペ先のエクセルシートのセルがランダムに青くなるようになりました。
範囲選択をしてその青い部分を覆うと,消えたり消えなかったりしたり,いったん画面外にスクロールし戻ると消えていたり・・そのままも。枠だけが水色(この色はコピペ元のシートで入力したマクロで指定した色)になったりもします。これも同様,消えたり現れたりを繰り返します。恐らくマクロを組んだシートのデータなので,何か余分なものまで持ってきてしまっているような状態なのだと思います。いろいろ調べていますが同じ症例が見当たらず,改善策を教えて頂きたく質問させて頂きました。
有識の方よろしくお願いします。

Aベストアンサー

No.1 の追補

標準モジュールではなくシートモジュールやワークブックモジュールにコードは残っていませんか?
下図の赤く囲まれた部分をクリックしてみてください。

Qexcel VBA 空白セルに上のセル値を入れる

お世話になります。
下記のようなデータで、A列の文字データの
下には2行の空白セルがあります。

VBAで5行目、13行目のように1行しか文字
データの無い行だけをVBAマクロで下のセルに
転記したいのですが御指導願えないでしょうか。
よろしくお願いいたします


転記前
  A  B    C
1 山田 xxxxx  xxxx 
2 山田 xxxxx  xxxx   
3    
4    
5 鈴木 xxxxx  xxxx
6 

8 山川 xxxxx  xxxx
9 山川 xxxxx  xxxx
10 山川 xxxxx  xxxx 
11
12
13 下川 xxxxx  xxxx
14
15


下のように転記したい
  A  B    C
1 山田 xxxxx  xxxx 
2 山田 xxxxx  xxxx   
3    
4    
5 鈴木 xxxxx  xxxx
6 鈴木

8 山川 xxxxx  xxxx
9 山川 xxxxx  xxxx
10 山川 xxxxx  xxxx 
11
12
13 下川 xxxxx  xxxx
14 下川
15

お世話になります。
下記のようなデータで、A列の文字データの
下には2行の空白セルがあります。

VBAで5行目、13行目のように1行しか文字
データの無い行だけをVBAマクロで下のセルに
転記したいのですが御指導願えないでしょうか。
よろしくお願いいたします


転記前
  A  B    C
1 山田 xxxxx  xxxx 
2 山田 xxxxx  xxxx   
3    
4    
5 鈴木 xxxxx  xxxx
6 

8 山川 xxxxx  xxxx
9 山川 xxxxx  xxxx
10 山川 xxxxx  ...続きを読む

Aベストアンサー

こんな感じでいかがでしょうか?
--------------------------------------------------------------------
Sub Sample()
Dim 行 As Long
For 行 = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(行, 1).Value <> "" Then
If Cells(行, 1).Value <> Cells(行 - 1, 1).Value Then
Cells(行 + 1, 1).Value = Cells(行, 1).Value
End If
End If
Next
If Range("A1").Value <> "" Then
If Range("A2").Value = "" Then
Range("A2").Value = Range("A1").Value
End If
End If
End Sub
--------------------------------------------------------------------

こんな感じでいかがでしょうか?
--------------------------------------------------------------------
Sub Sample()
Dim 行 As Long
For 行 = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(行, 1).Value <> "" Then
If Cells(行, 1).Value <> Cells(行 - 1, 1).Value Then
Cells(行 + 1, 1).Value = Cells(行, 1).Value
End If
End If
Next
If Range("A1").Value <> "" Then
If Range("A2").Value = "" Then
Range("A2").Value = Range("A1").Value
En...続きを読む


人気Q&Aランキング

おすすめ情報