5ちゃんねる ★スマホ版★ ■掲示板に戻る■ 全部 1- 最新50  

■ このスレッドは過去ログ倉庫に格納されています

エクセルVBA質問&研究板

1 :やみぺぐ:01/12/13 13:58
おしながき:
1.質問する時は丁寧に、教えてあげる時は偉そうに。
2.質問に対する答えが返ってこなくても、こかない。
3.回答できる人がいれば、どうぞ質問に答えてあげて
  ください。
4.他人への暴言、卑下は即刻オーナーに言って、調べ
  てもらい、警察へ届け出ます。良識常識のある言葉
  を使いましょう。
5.初心者に優しい板を目指してますが、単に教えて厨
  房なら、無視してもかまいません。

701 :名無しさん@そうだ選挙にいこう:03/01/23 00:28
全角文字から半角文字への修正を自動で行う機能を考えてます。
機能的には、セルに入力後、自動修正といったようになります。
僕が考えた方法としては、

1. ExcelのASC関数を用いる
2. VBAのStrConv関数を用いる
3. Excelの「入力規則」で日本語入力を無効にして
  そもそも全角文字を入力させない

などを考えましたが、それぞれ

1. 自セルを参照しているため、循環参照となる
2. マクロの実行は手動のため、完全自動修正ではない
3. 他のセルのコピー&ペーストにより、
  全角文字の入力が可能となってしまう

などの問題が生じてしまいます。
何か良い方法ないですかね?

702 :なな:03/01/23 00:40
どなたか教えてください。
個人用マクロブックのマクロを削除しょうとしていたら、BOOK1が表示されなくなってしまいました。
エクセルを立ち上げ直してもPASONALの方が、表示されます。元に戻す方法を教えてください。

703 :名無しさん@そうだ選挙にいこう:03/01/23 00:42
>>701
VBAが分かるなら絶対(2)。
Changeイベントで。

704 :名無しさん@そうだ選挙にいこう:03/01/23 00:48
>>702
Personal.xlsを削除したら良いかも
Winの検索で見つかるでしょ?

705 :701:03/01/23 00:57
>>703
VBAはじめたばかりでChangeイベントというのは知らなかったんですけど
調べたらわかりました。
ありがとうございました!

706 :名無しさん@そうだ選挙にいこう:03/01/23 00:59
>>702
Personal.xls選んどいて、ウインドウ→表示しない
Book1はウインドウ→再表示→Book1を選択かな

707 :( ´Α`):03/01/23 02:29
>>697
レスが遅くなってすいません。
バッチリできました、ありがとうございます。


708 :( ´Α`) :03/01/23 14:32
半角以外エラーを出す場合にはどうすんの?
おせーて 

709 :名無しさん@そうだ選挙にいこう:03/01/23 15:05
>>708
=IF(LEN(A1)=LENB(A1),"OK","NG")

710 :名無しさん@そうだ選挙にいこう:03/01/23 16:08
>>699
Cドライブの「Data」フォルダに「MyData1.xls」〜「MyData100.xls」が
あるとする。また、シート名は「Sheet1」とする。
マクロを実行するときにアクティブなワークブックのSheet1に書き込まれる。

Sub Macro1()
Dim MyFile, MySheet, ThisFile As String
Dim i, j As Integer
ThisFile = ActiveWorkbook.Name
MyFile = "C:\Data\MyData"
MySheet = "Sheet1"
For i = 1 To 100
Workbooks.Open FileName:=MyFile & Format(i) & ".xls", ReadOnly:=True
For j = 1 To 10
Workbooks(ThisFile).Sheets("Sheet1").Cells(j, i) = ActiveWorkbook.Sheets(MySheet).Cells(j, 1)
Next j
ActiveWorkbook.Close
Next i
End Sub

711 :どぶねずみ:03/01/23 17:11

A(列) B C
従業員番号従業員氏名(漢字) 従業員氏名(カナ)
12345678    矢田亜希子      タケダクミコ
12354567    高輪のやしろ明き夫人 ノビ
23456274    123456789       

上のようなデータを従業員番号、氏名(漢字)、(カナ)の順にエラーをチェック
していくのですが、エラーがある場合にはそこのセルを指定してメッセージボ
ックスをだしたいのです。もし、従業員番号にエラーがなければそこの列全部
を読み込んだ時点で従業員番号OKとメッセージをだし、(漢字)チェックに
移るという仕様でかんがえております。





712 :どぶねずみ:03/01/23 17:14
今は
Private Sub CommandButton1_Click()
Dim i, ErNum As Long
ErNum = 0
For i = 7 To 10 '調べる行を入れる
If Len(Cells(i, 1)) <> 8 Then '調べる列を指定
Cells(i, 1).Select
MsgBox (i & "・・・エラーです")
ErNum = ErNum + 1
End If
Next
If ErNum = 0 Then
MsgBox "エラーは無かったよ"
End If
Dim R As Range
with CreateObject("VBScript.RegExp")
Each R In Range("B7", Range("B10").End(xlDown))
If Not .test(Trim(R.Value)) Then
R.Select
If MsgBox(R.Address(0, 0) & "... Error発見") = vbOK Then
Exit Sub
End If
End If
Next
End With
End Sub
で、問題は数字の場合、空欄の場合はエラーがでないんですー。
お教えください 



713 :名無しさん@そうだ選挙にいこう:03/01/23 20:35
>>704
Winの検索ってなんですか?
すみません。
教えて下さい。
>>706
book1の再表示じたいがありません。

Book1の再表示じたいが、ありません。

714 :名無しさん@そうだ選挙にいこう:03/01/23 20:46
>>713
Windowsのスタート→検索のこと

Excelのメニュー→ウィンドウ→再表示

715 :名無しさん@そうだ選挙にいこう:03/01/23 20:54
>>712
IFを記述すれば良いだけだろ?
(数値はislng辺りでチェックして、空白は<>"")

716 :なな:03/01/23 21:06
ファイルではなく、Excelをたちあげると
Book1ではなくPerspnalがひらきます。
再表示は、ありません。


717 :名無しさん@そうだ選挙にいこう:03/01/23 21:11
>>716
メニュー→ウィンドウ→表示しない→Excel再起動
Personal.xlsは保存すること

718 :名無しさん@そうだ選挙にいこう:03/01/23 22:28
>691

マクロを組んだXLSファイルと同じフォルダに処理したいファイルを全部入れて実行

Sub Test()
Dim fs As FileSearch, openBook As Workbook, Col As Integer
Dim newBook As Workbook
On Error GoTo ERR
Application.ScreenUpdating = False
Set fs = Application.FileSearch
fs.NewSearch: fs.LookIn = ThisWorkbook.Path: fs.FileName = "*.xls"
If fs.Execute = 1 Then Exit Sub
Set newBook = Workbooks.Add(xlWBATWorksheet)
For i = 1 To fs.FoundFiles.Count
 If Dir(fs.FoundFiles(i)) <> ThisWorkbook.Name Then
   Set openBook = Workbooks.Open(fs.FoundFiles(i))
   Col = newBook.ActiveSheet.Range("IV1").End(xlToLeft).Column + 1
   openBook.ActiveSheet.Range("A1:A10").Copy
   newBook.ActiveSheet.Cells(1, Col).PasteSpecial (xlPasteAll)
   openBook.Close
 End If
Next i
Application.DisplayAlerts = False
newBook.ActiveSheet.Columns(1).Delete
ERR:
Application.DisplayAlerts = True
Set openBook = Nothing: Set newBook = Nothing: Set fs = Nothing
End Sub

719 :691:03/01/24 00:00
>>710>>718
見捨てられたと思ってたら、、、ありがとうございます!!
早速明日やってみます!!

720 :名無しさん@そうだ選挙にいこう:03/01/24 09:10
エクセル2kでセルに文字を入れて
そのセルに対角に斜線(/)を入れたいのですが
どうやったらできるのでしょうか?
よろしくお願いします。

721 :名無しさん@そうだ選挙にいこう:03/01/24 10:06
>>720
斜め罫線だよね。
自動記録でやってみれ。

722 :なな:03/01/25 00:05
>>717
ありがとうございます。やってみます。

723 :名無しさん@そうだ選挙にいこう:03/01/25 09:32
マクロのモジュールを一括解放できるツールはありませんか?
インポートはドラッグで簡単なんですけどね

724 :ああああ:03/01/26 13:43
すんません、うまくいかないので教えてください。
VBSのファイルから、エクセルを起動してファイルオープンのダイアログ
を表示したいのですが、(↓VBSファイル内の一部)

1:Dim objXL
2:Set objXL = CreateObject("Excel.Application")
3:objXL.Visible = TRUE
4:objXL.Dialogs(xlDialogOpen).Show

↑4行目で、実行時エラーが出てしまいます。これ、無理なんでしょうか?

725 :名無しさん@そうだ選挙にいこう:03/01/26 14:05
>>723

標準モジュールを全部消すマクロ
Sub HogeHoge()
  Dim Obj1 As Object, Obj2 As Object
  Set Obj1 = ActiveWorkbook.VBProject.VBComponents
  For Each Obj2 In Obj1
    '//Moduleだけ削除する
    If Obj2.Type = 1 Then Obj1.Remove Obj2
  Next
  Set Obj1 = Nothing
End Sub

XPでは制限があるらしいですが。

726 :名無しさん@そうだ選挙にいこう:03/01/26 17:09
組込定数が使えないようで。

xlDialogOpen=1なので

Dim objXL, DlgAns
Set objXL = CreateObject("Excel.Application")
objXL.Visible = TRUE
objXL.Dialogs(1).Show


727 :726:03/01/26 17:11
>>724
が抜けてました。

728 :名無しさん@そうだ選挙にいこう:03/01/26 18:27
>>725
> XPでは制限があるらしいですが。

ツール→マクロ→セキュリティ
→「Visual Basic プロジェクトへのアクセスを信頼する」にチェック

729 :名無しさん@そうだ選挙にいこう:03/01/26 19:28
>>725
>>728
ありがとうございます。試してみます。

730 :ああああ:03/01/26 20:53
>>726-727 ありがとうございます。ありがd。

731 :名無しさん@そうだ選挙にいこう:03/01/27 01:38
一つ質問なのですが、
  並び替え前      並び替え後
A B C A  B  C   A A B B C C
1 4 7 10 13 16 1 10 4 13 7 16
2 5 8 11 14 17 ⇒ 2 11 5 14 8 17
3 6 9 12 15 18 3 12 6 15 9 18

上のように並び変える場合、簡単な方法で並び変え可能でしょうか?
もし、ありましたらアドバイス教えてください。
また、このように変換できるマクロがあるのでしょうか?

732 :名無しさん@そうだ選挙にいこう:03/01/27 01:44
>>731
A B C A B C ⇒ A A B B C C
と言うところが、よく分からない。

マクロは「ある」のじゃなくて、「作る」ものなんだけど・・・。

733 :名無しさん@そうだ選挙にいこう:03/01/27 06:02
マクロの一括エキスポートする方法も教えて欲しい

734 :名無しさん@そうだ選挙にいこう:03/01/27 09:43
>>731
横のソートは簡単にはできないかと
別のシートにコピペする際に縦横換えてソート
それをさらに別のシートに縦横換えてコピペ


735 :名無しさん@そうだ選挙にいこう:03/01/27 12:06

セルA1が「a」ならセルA2は「1」
セルA1が「b」ならセルA2は「2」
セルA1が「c」ならセルA2は「3」
セルA1が「d」ならセルA2は「4」
セルA1が「e」ならセルA2は「5」
.
.
.
.        
みたいな表を作成したのですがイマイチ上手く行きません。
商品名やら社名やらを入力すると自動的にそれに対応するコードが出るようなそんな表です
どなたか宜しくお願いします

736 :dada:03/01/27 15:52
みなさん、教えてください。
従業員番号従業員氏名(漢字)従業員氏名(カナ)
12345678     矢田亜希子第一
123456789     [空白] ダイイチ

従業員番号八桁、 従業員氏名全角(漢字)、 従業員氏名(カナ)、
それぞれ、空欄などの場合はエラーを出す処理を考えています。
最後、カナのところを考えていますが、わかりません。おしえてください。




737 :dada:03/01/27 15:57
上のものですが、ちなみに今のところは次の部分まで考えました。
Private Sub CommandButton1_Click()
Dim i As Long, j As Long
Dim s As Boolean
For i = 1 To 3
s = False
For j = 7 To Range("A65536").End(xlUp).Row
If kanji(Cells(j, i), i) Then
s = True
End If
' ErNum = ErNum + 1
'If ErNum = 0 Then
Next
If s = False Then
MsgBox "列目エラーなし"
End If
Next
End Sub
Function kanji(myR As Range, myI As Long) As Boolean


738 ::03/01/27 15:57
Select Case myI
Case 1
If Len(myR.Value) <> 8 Then
myR.Select
MsgBox "文字数エラー"
kanji = True
End If
Case 2
If myR.Value = "" Then
myR.Select
MsgBox "空白セル発見"
kanji = True
Else
If LenB(myR.Value) = _
LenB(StrConv(myR.Value, vbFromUnicode)) Then
Else
myR.Select
MsgBox "半角文字発見"
kanji = True
End If
End If
End Select
End Function



739 : :03/01/27 18:47
セルのA1からA10までにそれぞれ数値が入っているとして、
1つおきずつのセルを選択してコピーし、それをとなりの列に並べたいのですが
VBAでどうやればいいですか?

740 :名無しさん@そうだ選挙にいこう:03/01/27 18:53
>>733

Sub HogeHoge()
  Dim Obj1 As Object, Obj2 As Object, DirName As String
  '//ActiveWorkbookが対象
  With ActiveWorkbook
    Set Obj1 = .VBProject.VBComponents
    If .Path <> "" Then DirName = .Path Else PathName = CurDir
  End With
  DirName = DirName & Application.PathSeparator
  For Each Obj2 In Obj1
'//タイプが標準Moduleかつ空でないものだけExport
    With Obj2
      If .Type = 1 And .CodeModule.CountOfLines > 0 Then
        .Export DirName & .Name & ".Bas"
      End If
    End With
  Next
  Set Obj1 = Nothing
End Sub

741 :名無しさん@そうだ選挙にいこう:03/01/27 19:06
>>731

A1:F4までその表が入っているとすると。

A1:F4を選択し、
 データ→並べ替え→ オプションで 方向を列単位に変更し、
 ソートキーを最優先キーを行1・昇順、2番目のキーを行2・昇順としてOK

これをマクロで記録して、Select・Selectionをはずすと、

Sub HogeHoge()
Range("A1:F4").Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("A2") _
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight, SortMethod:=xlPinYin
End Sub

742 :名無しさん@そうだ選挙にいこう:03/01/27 19:10
>>735
(V/H)LOOKUPワークシート関数またはSUMIFワークシート関数でいいのでは?

743 :名無しさん@そうだ選挙にいこう:03/01/27 19:48
>>742
いや、それがなぜかうまくいかなくて...
スイマセン、式を教えていただけるとありがたいのですが...

744 :名無しさん@そうだ選挙にいこう:03/01/27 20:06
>>740
ありがとうございます。
こういうマクロは便利です。

745 :名無しさん@そうだ選挙にいこう:03/01/27 22:11
>>743
A1:A10に会社名、B1:B10にコード番号、C1に検索する会社名が入ってる場合。

ツール → アドイン でLookupウィザードにチェックがついてるのをまず確認

=VLOOKUP(C1,A1:B10,2,FALSE)
でC1セルの値と対応するコード番号が取得できます。
会社名が無かったらエラーになります。

もし、会社コードが数値(数値として演算可能)ならば、
=IF(COUNTIF(A1:A10,C1)>1,"複数一致",IF(COUNTIF(A1:A10,C1)=0,"一致なし",SUMIF(A1:A10,C1,B1:B10)))
という式でLookUp風の処理が出来ます。

746 :745:03/01/27 22:23
>ツール → アドイン でLookupウィザードにチェックがついてるのをまず確認
 ずっと勘違いしてますた。必要なかったようです、スマソ。

LOOKUPワークシート関数を使うとV(H)LookUpと同じように数値以外も取れます。

=LOOKUP(C1,A1:A10,B1:B10)

VLookUpの最後の引数が省略またはTrueの時と同じく、検索キーが昇順に並んでないとだめなんだそうです。

747 :名無しさん@そうだ選挙にいこう:03/01/27 23:04
>737

関数の方が速いと思うが。。。
=IF(AND(LEN(A7)=8,ISNUMBER(A7)),1,0)
=Mod(Len(B7),2)
=IF(AND(LENB(C7)=LENB(JIS(C7)),LENB(C7)/2=LENB(ASC(C7))),1,0)

Sub aaa()
Dim r As Range, s As Range
Set r = Range("A7:A" & Range("A65536").End(xlUp).Row)
For i = 0 To 2
 For Each s In r.Offset(0, i)
  Select Case i
  Case 0
   If Not IsNumeric(s) Or Len(s) <> 8 Then
     MsgBox s.Address & ""
   End If
  Case 1
   If s = "" Or _
    (LenB(StrConv(s, 128)) Mod 2) > 0 Then
     MsgBox s.Address
   End If
  Case Else
   If s = "" Or _
    s <> StrConv(s, 4) Or s <> StrConv(s, 16) Then
     MsgBox s.Address
   End If
  End Select
 Next s
Next i
End Sub

748 :名無しさん@そうだ選挙にいこう:03/01/28 11:03
>>745,746
サンクスです!上手く行かなかった理由がわかりました。
で、ふと思ったのですが、このようにしてとったコードナンバーを連番でとる事ってできるのでしょうか?

例えば「a」がこの表の中で2回目なら「1002」、3回目なら「1003」、4回目なら「1004」
同じく「b」がこの表の中で2回目なら「2002」、3回目なら「2003」、4回目なら「2004」
みたいな感じです。

こう言う事って可能なんでしょうか?VLOOKUPで各社名に対応したコードを表示させつつも
そのコードを連番で取る、みたいな...

749 :名無しさん@そうだ選挙にいこう:03/01/28 11:13
>>748
VBAが解るなら楽勝


750 :748:03/01/28 19:05
>>749
いや、VBA解りませぬ...今時情けない話ですが、まだ未知の領域でして...
教えて頂けるとありがたいです


235 KB
■ このスレッドは過去ログ倉庫に格納されています

★スマホ版★ 掲示板に戻る 全部 前100 次100 最新50

read.cgi ver 05.04.02 2018/11/22 Walang Kapalit ★
FOX ★ DSO(Dynamic Shared Object)