選択対象シート数は4つで、シート名は、「101」「102」「103」「104」とします。
シート名「表紙」のA列のセルはA10：101 A11：102 A12：103 A13：104となっており、
使用者はとなりのB10～B14セルに「○」「×」を入力規則から選択します。
また、シート名「表紙」のB6セルには製造番号（例：AM01-130012）を入力しておきます。
「○」となっているシートのみ選択して、下記マクロにてコピーを作成します。
コピーしたシートすべてのB2セルに製造番号を入力します。
ここまではできていて、下記のプログラムを追加したいのですが、うまくいきません。
さらに、○を付けたのと同じ行のD10～L10、D11～L11、D12～L12、D13～L13セルに、
使用者が文字列を入れる場合と入れない場合があります。文字列は左のD列から順に入れます。
文字列があれば、○を付けてコピーした対応するシートの中のH3～P3セルへ貼り付けたいのです。
D10、D11、D12、D13セルが空白のときは何も処理は行わないとします。
たとえば、下記のようにB12セルが○で、D12セルに文字列があれば、
D12～L12セルの値を、コピーで作成したシート103の中のH3～P3セルへ貼り付けたいのです。
B11セルも○ですが、D11セルに文字列がないのでシートのコピーだけ行います。
アドバイスいただけると助かります。
VBA初心者で申し訳ございませんが、よろしくお願いいたします。
＜表紙のシート＞
A B C D E F G H I J K L
5
6 AM01-130012
7
8
9
10 101 ×
11 102 ○
12 103 ○ A1-1 A1-2 A1-3 A1-4 A1-5 A1-6 A1-7 A1-8 A1-9
13 104 ×
＜プログラム＞
Sub TestSample()
If Application.CountIf(Worksheets("表紙").Range("B10:B17"), "*○*") = 0 Then
MsgBox "部品番号が選択されていません。"
Exit Sub
End If
Dim 製造番号 As String
製造番号 = Range("B6").Value
Dim c As Range
Dim flg As Boolean
On Error Resume Next
flg = True
ThisWorkbook.Activate
On Error GoTo ErrOut_
For Each c In Worksheets("表紙").Range("B10:B13")
If c.Value Like "○*" Then
Worksheets(c.Offset(, -1).Text).Select flg
flg = False
End If
Next c
If Not flg Then ActiveWindow.SelectedSheets.Copy
' コピーしたすべてのシートに製造番号を書き込む
For Each 各シート In Worksheets
With 各シート
.Activate
Cells(1, 2) = 製造番号
End With
Next
Exit Sub
ErrOut_:
MsgBox """表紙""シートに記載されたシート名" & c.Offset(, -1).Text & "は存在しません。, vbInformation"
End Sub
選択対象シート数は4つで、シート名は、「101」「102」「103」「104」とします。
シート名「表紙」のA列のセルはA10：101 A11：102 A12：103 A13：104となっており、
使用者はとなりのB10～B14セルに「○」「×」を入力規則から選択します。
また、シート名「表紙」のB6セルには製造番号（例：AM01-130012）を入力しておきます。
「○」となっているシートのみ選択して、下記マクロにてコピーを作成します。
コピーしたシートすべてのB2セルに製造番号を入力します。
ここまではできていて、下記のプログラムを追加したいのですが、うまくいきません。
さらに、○を付けたのと同じ行のD10～L10、D11～L11、D12～L12、D13～L13セルに、
使用者が文字列を入れる場合と入れない場合があります。文字列は左のD列から順に入れます。
文字列があれば、○を付けてコピーした対応するシートの中のH3～P3セルへ貼り付けたいのです。
D10、D11、D12、D13セルが空白のときは何も処理は行わないとします。
たとえば、下記のようにB12セルが○で、D12セルに文字列があれば、
D12～L12セルの値を、コピーで作成したシート103の中のH3～P3セルへ貼り付けたいのです。
B11セルも○ですが、D11セルに文字列がないのでシートのコピーだけ行います。
アドバイスいただけると助かります。
VBA初心者で申し訳ございませんが、よろしくお願いいたします。
＜表紙のシート＞
A B C D E F G H I J K L
5
6 AM01-130012
7
8
9
10 101 ×
11 102 ○
12 103 ○ A1-1 A1-2 A1-3 A1-4 A1-5 A1-6 A1-7 A1-8 A1-9
13 104 ×
＜プログラム＞
Sub TestSample()
If Application.CountIf(Worksheets("表紙").Range("B10:B17"), "*○*") = 0 Then
MsgBox "部品番号が選択されていません。"
Exit Sub
End If
Dim 製造番号 As String
製造番号 = Range("B6").Value
Dim c As Range
Dim flg As Boolean
On Error Resume Next
flg = True
ThisWorkbook.Activate
On Error GoTo ErrOut_
For Each c In Worksheets("表紙").Range("B10:B13")
If c.Value Like "○*" Then
Worksheets(c.Offset(, -1).Text).Select flg
flg = False
End If
Next c
If Not flg Then ActiveWindow.SelectedSheets.Copy
' コピーしたすべてのシートに製造番号を書き込む
For Each 各シート In Worksheets
With 各シート
.Activate
Cells(1, 2) = 製造番号
End With
Next
Exit Sub
ErrOut_:
MsgBox """表紙""シートに記載されたシート名" & c.Offset(, -1).Text & "は存在しません。, vbInformation"
End Sub
ｖｂａで数式をセルに入れる際に、アルファベットで列を指定するのではなく
数値で指定する場合、どうすればいいでしょうか？
例えば、Ａ１セルに
Sub Sample()
Cells(1, 1) = "=a2+a3"
End Sub
と言う結果にしたい場合、
a列の部分も数値で指定したいです。
Sub Sample()
Cells(1, 1) = "=" & Cells(2,1) & "+" & Cells(3,1)
End Sub
こういうことをやりたいのですが
これだとエラーになってしまいます。
方法を教えてください。
エクセルVBAのシート選択方法について教えてください。
選択対象シート数は4つで、シート名は、「101」「102」「103追加工」「104」とします。
シート名「表紙」のセルは
A1：101 A2：102 A3：103追加工 A4：104となっており、
使用者はB1～B4セルに「○」「×」を入力し、
「○」となっているシートのみ選択出来るようにしたい。
下記マクロの場合、シート名が全角文字だと使えるのですが、
シート名が「101」のように半角数字だけの場合コピーできません。
どこを修正すればよいのでしょうか？
Sub TestSample2()
Dim c As Range
Dim flg As Boolean
On Error Resume Next
flg = True
ThisWorkbook.Activate
With Worksheets("表紙")
For Each c In .Range("B1:B4")
If c.Value Like "○*" Then
Worksheets(c.Offset(, -1).Value).Select flg
flg = False
End If
Next c
End With
With ActiveWindow.SelectedSheets
If .Count > 0 Then
.Copy
End If
End With
'元のシートに戻る場合
'Application.Goto ThisWorkbook.Worksheets("表紙").Range("A1")
End Sub
こちらの識者の方々にはいつもお世話になっています。
VBAの質問です。
環境は下記になります。
OS=windowsXP SP3
Office=Excel2003(11.8347.8403) SP3
会社などで一般的にVBAを使用してデータの処理をする場合、自動で吐き出されるcsvファイルを読み込んで、そのデータを加工し、使いたいデータに成型する。というケースが往々にしてあると思うのですが、吐き出されるcsvファイルのタイトル行が今までのものと同一でない（フィールドが知らないうちに増えたり減ったりしている）場合を想定し、csvファイルを取り込んだ時点でタイトル行の検査をしたいのですが、csvファイルのタイトル行を一旦配列に格納し、あらかじめ用意しておいたタイトル行のデータと比較する場合、配列内の一要素ずつ検査するしかないのでしょうか？
例としてはタイトル行が
"品名", "4月", "5月", "6月", "7月", "8月", "9月"
と仮定し、
Sub test()
Dim EndClm As Long
Dim TitleA As Variant
Dim TitleB As Variant
Dim i As Long
EndClm = Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
TitleA = Workbooks("aa.csv").Sheets(1).Range(Sheets(1).Cells(1, 1),Sheets(1).Cells(1, EndClm)) 'csvファイルのタイトル行
TitleB = ThisWorkbook.Sheets(1).Range(Sheets(1).Cells(1, 1), Sheets(1).Cells(1, EndClm)) '検証用 "品名", "4月", "5月", "6月", "7月", "8月", "9月"
For i = 1 To UBound(TitleA, 2)
If TitleA(1, i) <> TitleB(1, i) Then MsgBox "項目が変更されています"
Next i
End Sub
のようなコードで1つずつ検証できますが、配列内の要素を一気に検証する方法はありますか？
当然通りませんが
If TitleA <> TitleB Then MsgBox "項目が変更されています"
のような感じです。
短いコードで確実にタイトル行の検査が行われれば、上記の配列に取り込んで要素を検証することに特に頓着はしていません。
今このテストコードを自宅のWindows7,Excel2010で書いていて思ったのですが、TitleA、TitleB共に配列に取り込む際、ブックをアクティブにしないとエラーが起きてしまいます。
もしよろしければこの原因も併せて教えていただいてもよろしいでしょうか。
質問に不備不足等ございましたらご指摘ください。
ご面倒お掛けしますがよろしくお願いします。
文字列を数式に変換する標準モジュール「EVALUATE」の更新が不安定です
エクセルシート内の文字列を数式に変換して、計算結果を返すために下記標準モジュールを登録して試すのですが
うまく行ったりいかなかったり、標準モジュールが安定して機能しない原因などが分かりません。
●現在の設定とやりたいこと
(1)Ａ１⇒=myEvalAry(B1)、B1⇒C1+D1、C1⇒2、D1⇒5 として、A1にC1+D1計算結果の7を表示させたい
(2)一つのシートの中に、myEvalAry標準モジュールを数百使っている
(3)一つのセルの中で、=myEvalAry(B1)+myEvalAry(B2)のように標準モジュールを複数使っているセルもある
●現在の状況
上記状態で、何かのタイミングで標準モジュールの計算結果が一気に全て正しく反映されることもあれば、
急に反映されなくなることもある。１００のうち１０だけ反映されることもある。
というような不安定な状態です。
しかも数量が問題かと思って、多量に登録していたmyEvalAryのセルを１つだけにして動きを確認しようとしたらまた反映
されなかったりで、全然理由が分かりません。
どこか標準モジュール内に、考慮すべき構文が漏れたりしてるのでしょうか？？？？
正常稼働しない理由が分かると大変ありがたいです。win7、win8、excel2003、excel2013のいずれの環境でも同様です。
///////////////////////////////////////////////////////
Function myEvalAry(ParamArray ItemR()) As Variant
Dim re As Variant
Dim strTmp As String
Dim varR As Variant
Dim i As Variant, j As Variant
strTmp = ""
varR = ItemR()
For Each i In varR
If IsArray(i) Then
'引数が配列の場合
For Each j In i
If IsNumeric(j) Then
re = CStr(j)
Else
re = j
End If
strTmp = strTmp & re
Next
Else
'引数が配列以外
If IsNumeric(i) Then
re = CStr(i)
Else
re = i
End If
strTmp = strTmp & re
End If
Next
myEvalAry = Application.Evaluate(strTmp)
End Function
下記VBAでコンパイルエラーを起こして進みません
解消法をご教授いただけると幸いです
やりたいこととしては
ボタンで任意のタブ区切りのテキストを指定し
特定のシートに値をコピーすることです
----
Private Sub CommandButton1_Click()
Dim Sh As Worksheet
Dim FileN As String
Set Sh = ThisWorkbook.Sheets("import") ' <-- 読込みシート指定(※)
FileN = Application.GetOpenFilename("テキストファイル,*.txt")
If FileN <> "False" Then
Workbooks.OpenText Filename:=FileN, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlTextQualifierNone, Tab:=True
End If
Set Sh = Nothing
End Sub
----
下記VBAでコンパイルエラーを起こして進みません
解消法をご教授いただけると幸いです
やりたいこととしては
ボタンで任意のタブ区切りのテキストを指定し
特定のシートに値をコピーすることです
----
Private Sub CommandButton1_Click()
Dim Sh As Worksheet
Dim FileN As String
Set Sh = ThisWorkbook.Sheets("import") ' <-- 読込みシート指定(※)
FileN = Application.GetOpenFilename("テキストファイル,*.txt")
If FileN <> "False" Then
Workbooks.OpenText Filename:=FileN, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlTextQualifierNone, Tab:=True
End If
Set Sh = Nothing
End Sub
----
