Excelデータで名前をスペースで入れて7文字組みに変換させたいのですが、
関数またはVBAなどの方法を教えていただけませんでしょうか?
今は関数で個別でMID関数を使い分けてしています。

例) 
林一    → 林     一     田中一   → 田 中   一
林太郎   → 林   太 郎     田中太郎  → 田 中 太 郎
林孝太郎  → 林   孝太郎     田中孝太郎 → 田 中 孝太郎

佐々木一  → 佐々木   一
佐々木太郎 → 佐々木 太 郎
佐々木孝太郎→ 佐々木 孝太郎

A 回答 (5件)

板汚しすみません。

まだ半角スペース残ってた
=CHOOSE(LEN(A2),,LEFT(A2,1)&REPT(" ",5)&RIGHT(A2,1),
REPLACE(LEFT(A2,B2),2,0,REPT(" ",B2-1))&REPT(" ",3)&REPLACE(RIGHT(A2,3-B2),2,0,REPT(" ",2-B2)),
IF(MOD(B2,2),LEFT(A2,B2)&REPT(" ",3)&RIGHT(A2,4-B2),
REPLACE(LEFT(A2,2),2,0," ")&" "&REPLACE(RIGHT(A2,2),2,0," ")),
IF(OR(B2=1,B2=4),LEFT(A2,B2)&REPT(" ",2)&RIGHT(A2,5-B2),
REPLACE(LEFT(A2,B2),2,0,REPT(" ",3-B2))&" "&REPLACE(RIGHT(A2,5-B2),2,0,REPT(" ",B2-2))),
LEFT(A2,B2)&" "&RIGHT(A2,6-B2),A2)
    • good
    • 1
この回答へのお礼

出来れば関数の内容などを教えていただけると助かります^^

お礼日時:2017/06/14 15:25

こんにちは。



とても気になった質問なので、私も本格的に試してみました。
なかなか手間の掛かる準備が必要です。

VBA系とは違う種類のプログラムですが、あえて、それをVBAでやってみました。
当然、VBAだけでは、不可能ですし、当然、関数だけでも不可能です。形態素解析のツールのkakasi を使って分かち書きをするわけですが、ただ、本来は人名辞典が必要です。MS-IMEの辞書は、今は抜き取れないのでしょうか?昔のWXの時代なら、取り出せたのですが。

Vector には以下のような人名辞書があります。WXIII用のものもあるようです。これは、テキストファイルですから、容易に抜き出せます。
http://www.vector.co.jp/vpack/filearea/data/writ …

今回は、私にとっても初めての組み込みで、デフォルトの辞書のままでやってみました。
「田中一」なら、反応するのに、「田中角栄」には反応しないという矛盾とも思える現象があります。

まず、Kakasi というプログラムを手に入れてください。

kakasi-2.3.4.zip
http://www.namazu.org/win32/

1)Windowsへの「kakasi」の導入方法
http://language-and-engineering.hatenablog.jp/en …

ここらを参考にしてみてください。Path をコンパネのシステムから加えるのもお忘れなく。
辞書は、mkkanwa.exe を使って作ります。
まだ、細かい所はチェックしていませんが、仕組みは分かっていただけるはずです。

'//
Sub KakasiForVBA()
 Dim ret As Variant
 Dim myName As String
 Dim c As Variant, k As Long, k2 As Long
 Dim fmt1 As String, fmt2 As String
 Dim faName As String, fiName As String
 With Range("B2", Cells(Rows.Count, 2).End(xlUp))
  .ClearContents
  .Font.Name = "MS ゴシック"
 End With
 
 For Each c In Range("A2", Cells(Rows.Count, 1).End(xlUp))
 Application.ScreenUpdating = False 'ループが終わったら見えるようにする
  Do
   myName = Replace(c, Space(1), "", , , vbTextCompare)
  Loop Until InStr(1, myName, Space(1), vbTextCompare) = 0
  If c.Value Like "[一-龠]*" Then
   ret = DivideName(CStr(c.Value))
   ret = Application.Clean(ret)
   ret = Trim(ret)
   If ret <> "0" Then
    k = InStr(ret, Space(1))
    k2 = InStr(k + 1, ret, Space(1))
    If k > 0 Then
     'family name
     If k2 = 4 Then
     faName = Trim(Mid(ret, 1, k2 - 1))
     Else
     faName = Trim(Mid(ret, 1, k - 1))
     End If
     faName = Replace(faName, Space(1), "")
     Select Case Len(faName)
     Case 1: fmt1 = "@" & Space(3)
     Case 2: fmt1 = "@ @"
     Case 3: fmt1 = "@@@"
     Case 4: fmt1 = "@@@@"
     End Select
     faName = Format$(faName, fmt1)
     'first name
     If k2 = 4 Then
     fiName = Trim(Mid(ret, k2 + 1))
     Else
     fiName = Trim(Mid(ret, k + 1))
     End If
     fiName = Replace(fiName, Space(1), "")
     Select Case Len(fiName)
     Case 1: fmt2 = Space(4) & "@"
     Case 2: fmt2 = Space(1) & "@" & Space(1) & "@"
     Case 3: fmt2 = "@@@"
     Case 4: fmt2 = "@@@@"
     End Select
     fiName = Format$(fiName, fmt2)
     c.Offset(, 1).Value = Space(1) & faName & Space(1) & fiName
     faName = "": fiName = ""
     End If
    End If
   End If
   Application.ScreenUpdating = True
  Next
 End Sub
 
 Function DivideName(ByVal myName As String)
 Dim WShell As Object
 Dim oExec As Object
 Dim sResult As String
 Dim sCommand As String
 Dim execmd As String
 Dim nowDir As String
 nowDir = ThisWorkbook.Path 'CurDir()
 Set WShell = CreateObject("WScript.Shell")

 ChDir "c:\kakasi"
 execmd = " c:\kakasi\bin\kakasi.exe -w"
 sCommand = "cmd /c echo " & myName & " |" & execmd 'kakasi -w"
 Set oExec = WShell.Exec(sCommand)

 Do Until oExec.Status: DoEvents: Loop

 If Not oExec.StdErr.AtEndOfStream Then
  sResult = oExec.StdErr.ReadAll
 ElseIf Not oExec.StdOut.AtEndOfStream Then
  sResult = oExec.StdOut.ReadAll
 End If
 If sResult <> "" Then
  ''Debug.Print sResult
  DivideName = sResult
 Else
  DivideName = "0"
 End If
 ChDir nowDir
End Function
'//

注:このkakasiは、姓と名の分かち書きを任せているにすぎず、細かな調整をしているわけではありません。
「Excelで名前の7文字組みの方法を教え」の回答画像5
    • good
    • 1

一部半角スペースになっていたのを修正


=CHOOSE(LEN(A2),,LEFT(A2,1)&REPT(" ",5)&RIGHT(A2,1),
REPLACE(LEFT(A2,B2),2,0,REPT(" ",B2-1))&REPT(" ",3)&REPLACE(RIGHT(A2,3-B2),2,0,REPT(" ",2-B2)),
IF(MOD(B2,2),LEFT(A2,B2)&REPT(" ",3)&RIGHT(A2,4-B2),
REPLACE(LEFT(A2,2),2,0," ")&" "&REPLACE(RIGHT(A2,2),2,0," ")),
IF(OR(B2=1,B2=4),LEFT(A2,B2)&REPT(" ",2)&RIGHT(A2,5-B2),
REPLACE(LEFT(A2,B2),2,0,REPT(" ",3-B2))&" "&REPLACE(RIGHT(A2,5-B2),2,0,REPT(" ",B2-2))),
LEFT(A2,B2)&" "&RIGHT(A2,6-B2),A2)
    • good
    • 0

長いです。

文字数で分岐、B列名字の文字数(2文字と7文字の場合はいらないけど)
=CHOOSE(LEN(A2),,LEFT(A2,1)&REPT(" ",5)&RIGHT(A2,1),
REPLACE(LEFT(A2,B2),2,0,REPT(" ",B2-1))&REPT(" ",3)&REPLACE(RIGHT(A2,3-B2),2,0,REPT(" ",2-B2)),
IF(MOD(B2,2),LEFT(A2,B2)&REPT(" ",3)&RIGHT(A2,4-B2),
REPLACE(LEFT(A2,2),2,0," ")&" "&REPLACE(RIGHT(A2,2),2,0," ")),
IF(OR(B2=1,B2=4),LEFT(A2,B2)&REPT(" ",2)&RIGHT(A2,5-B2),
REPLACE(LEFT(A2,B2),2,0,REPT(" ",3-B2))&" "&REPLACE(RIGHT(A2,5-B2),2,0,REPT(" ",B2-2))),
LEFT(A2,B2)&" "&RIGHT(A2,6-B2),A2)
「Excelで名前の7文字組みの方法を教え」の回答画像2
    • good
    • 0

「金田一太郎」…さて、このかたは「かねだ いちたろう」さんでしょうか、「きんだいち たろう」さんでしょうか。



どこで区切るかを細かく指定する非常に大きなデータベースを抱えたプログラムになるので、
現状のやり方で良いと思います。
    • good
    • 0

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

このQ&Aを見た人はこんなQ&Aも見ています

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

Q数値の列から偶数のみを抽出する方法を教えてください

年齢列から偶数のみを抽出したいのですが何か数式か関数があれば教えてください。
宜しくお願いいたします。

Aベストアンサー

例えば年齢(A列として)の隣のセルに
=MOD(A2,2)=0
フィルハンドルダブルクリック
でオートフィルターで「TRUE」を抽出します

Qエクセルの、マクロとは何ですか?

エクセルの、マクロとは何ですか?

Aベストアンサー

エクセルの裏に貼り付けてあるVBと言うプログラムです。
ここにコードィングすれば、そのエクセルを開いて使う事が出来ます。
使う:プログラムを実行できる。

下は例です。
Sheet1のA列をSheet2のA列へ1個置きに転送する

Sub WK()
Dim CNT As Long
Dim END1 As Long
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet

Set Sh1 = Worksheets("Sheet1")
Set Sh2 = Worksheets("Sheet2")
END1 = Sh1.Range("B65536").End(xlUp).Row

For CNT = 2 To END1 STEP 2
Sh2.Range("A" & CNT).Value = Sh1.Range("A" & CNT1).Value
Next CNT
E1:
Application.StatusBar = False
End Sub

エクセルの裏に貼り付けてあるVBと言うプログラムです。
ここにコードィングすれば、そのエクセルを開いて使う事が出来ます。
使う:プログラムを実行できる。

下は例です。
Sheet1のA列をSheet2のA列へ1個置きに転送する

Sub WK()
Dim CNT As Long
Dim END1 As Long
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet

Set Sh1 = Worksheets("Sheet1")
Set Sh2 = Worksheets("Sheet2")
END1 = Sh1.Range("B65536").End(xlUp).Row

For CNT = 2 To END1 STEP 2
Sh2...続きを読む

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

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

Aベストアンサー

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

QVBAか関数でできるのでしょうか?

いつもこちらで皆さんに助けていただいてます。昨日質問しましたが画像が張り付けられていなかったので再度質問です。

”仕入表”タブに入力されたデータが横並びのデータです。
例えば、商品コード/品名/価格/色/入荷数 の並び順で、入力されています。一つの品番に対して色数は1から10個あり、色/入荷数/色/入荷数という風に構成されてます。

そこでこちらでお世話になり、仕入表に入力したデータを縦並びに色別で”在庫表”タブに表を作れるようなVBAを教えていただきました。

画像の仕入表は上の表で、下の表が在庫表に転記されたときの例です。
因みにその時のVBAはこちらです。


Sub Sample4() '//この行から
Dim i As Long, j As Long, cnt As Long, lastRow As Long, wS As Worksheet
Application.Calculation = xlCalculationManual
Set wS = Worksheets("仕入表")
With Worksheets("在庫表")
'//E列で「在庫表」Sheetの最終行取得★
lastRow = .Cells(Rows.Count, "E").End(xlUp).Row
'//「在庫表」SheetにデータがあればD列2行目~I列最終行データを一旦消去
If lastRow > 1 Then
.Range(.Cells(2, "D"), .Cells(lastRow, "I")).ClearContents
End If
cnt = 1
For i = 3 To wS.Cells(Rows.Count, "A").End(xlUp).Row '//「仕入表」Sheetの3行目~A列最終行まで
For j = 5 To wS.Cells(i, Columns.Count).End(xlToLeft).Column Step 2 '//E列~i行最終列まで2行毎★
If wS.Cells(i, j) <> 0 Then '//画像で「0」が表示されているので「0」以外を追加★
cnt = cnt + 1
'//最初のデータ行のみ「仕入表」Sheetの日付をD列に表示★
If j = 5 Then
.Cells(cnt, "D") = wS.Cells(i, "A")
End If
.Cells(cnt, "E") = wS.Cells(i, "B") '//B列に「コード」を表示
.Cells(cnt, "F") = wS.Cells(i, "C") '//F列に「商品名」を表示
.Cells(cnt, "G") = wS.Cells(i, "D") '//G列に「下代」を表示
.Cells(cnt, "H") = wS.Cells(i, j) '//H列に「色」を表示
.Cells(cnt, "I") = wS.Cells(i, j + 1) '//I列に「数」を表示
End If
Next j
Next i
'//最後にD列の表示形式(日付)を「在庫表」SheetのA3セルの書式に設定★
.Range("D1", Cells(Rows.Count, 4).End(xlUp)).NumberFormatLocal = wS.Range("A3").NumberFormatLocal
End With
Application.Calculation = xlCalculationAutomatic
End Sub '//この行まで


そこで、また新たにもしできるなら教えていただきたいことが出てきました。
仕入表タブのC列に出荷した商品が出たら「出荷済」と入力していますが(画像ではA列から埋まってますが実際はA~Cは空白にしてます)、”出荷済”にしたときに在庫表タブの同じ品番の商品すべて(日付~すべての色の個数まで)を黄色の色付けにすることはできますか?
もしできるとすごく楽になるのですが・・・
それではよろしくお願いします。

いつもこちらで皆さんに助けていただいてます。昨日質問しましたが画像が張り付けられていなかったので再度質問です。

”仕入表”タブに入力されたデータが横並びのデータです。
例えば、商品コード/品名/価格/色/入荷数 の並び順で、入力されています。一つの品番に対して色数は1から10個あり、色/入荷数/色/入荷数という風に構成されてます。

そこでこちらでお世話になり、仕入表に入力したデータを縦並びに色別で”在庫表”タブに表を作れるようなVBAを教えていただきました。

画像の仕入表は上の表で...続きを読む

Aベストアンサー

No6です。
以下の箇所を修正しました。前回のマクロをこれで入れ替えてください。
1)エラー13で型が一致しません。・・・この対策
色の箇所が0以外なら処理しているのを、空白以外なら処理するようにしました。
2)今更ですが黄色の色付けを日付の列だけにすることは可能でしょうか。
日付の列だけ黄色にしました。
-------------------------------------------------------
Sub Sample4() '//この行から
Dim i As Long, j As Long, cnt As Long, lastRow As Long, wS As Worksheet
Dim wns As Worksheet
Application.Calculation = xlCalculationManual
Set wS = Worksheets("仕入表")
Set wns = Worksheets("納品仕訳")
Worksheets("在庫表").Activate '追加
With Worksheets("在庫表")
'//E列で「在庫表」Sheetの最終行取得★
lastRow = .Cells(Rows.Count, "E").End(xlUp).Row
'//「在庫表」SheetにデータがあればD列2行目~I列最終行データを一旦消去
If lastRow > 1 Then
.Range(.Cells(2, "D"), .Cells(lastRow, "I")).ClearContents
.Range(.Cells(2, "D"), .Cells(lastRow, "I")).Interior.Pattern = xlNone
End If
cnt = 1
For i = 3 To wS.Cells(Rows.Count, "A").End(xlUp).Row '//「仕入表」Sheetの3行目~A列最終行まで
For j = 5 To wS.Cells(i, Columns.Count).End(xlToLeft).Column Step 2 '//E列~i行最終列まで2行毎★
If wS.Cells(i, j) <> "" Then '//画像で「0」が表示されているので「0」以外を追加★ '修正
cnt = cnt + 1
'//最初のデータ行のみ「仕入表」Sheetの日付をD列に表示★
If j = 5 Then
.Cells(cnt, "D") = wS.Cells(i, "A")
End If
.Cells(cnt, "E") = wS.Cells(i, "B") '//B列に「コード」を表示
.Cells(cnt, "F") = wS.Cells(i, "C") '//F列に「商品名」を表示
.Cells(cnt, "G") = wS.Cells(i, "D") '//G列に「下代」を表示
.Cells(cnt, "H") = wS.Cells(i, j) '//H列に「色」を表示
.Cells(cnt, "I") = wS.Cells(i, j + 1) '//I列に「数」を表示
If wns.Cells(i + 2, "C").Value = "出荷済" Then
.Range("D" & cnt).Interior.Color = 65535 '修正
End If
End If
Next j
Next i
'//最後にD列の表示形式(日付)を「在庫表」SheetのA3セルの書式に設定★
.Range("D1", Cells(Rows.Count, 4).End(xlUp)).NumberFormatLocal = wS.Range("A3").NumberFormatLocal
End With
Application.Calculation = xlCalculationAutomatic
End Sub '//この行まで
-------------------------------------

No6です。
以下の箇所を修正しました。前回のマクロをこれで入れ替えてください。
1)エラー13で型が一致しません。・・・この対策
色の箇所が0以外なら処理しているのを、空白以外なら処理するようにしました。
2)今更ですが黄色の色付けを日付の列だけにすることは可能でしょうか。
日付の列だけ黄色にしました。
-------------------------------------------------------
Sub Sample4() '//この行から
Dim i As Long, j As Long, cnt As Long, lastRow As Long, wS As Worksheet
Dim wns As Works...続きを読む

Qエクセル で 例えば 19.07.05と入力した場合

自動的に Hを頭に付けて H19.07.05 と表示させるにはどうしたら良いでしょうか?
教えて下さい。

Aベストアンサー

表示だけなら書式設定で可能ですが、
あくまで見た目しか変わらないので、日付として計算式に利用するには1手間2手間かけなければならなくなりますよ。
計算に用いるなら、Hも含めて日付として入力し、書式設定を日付の和暦にするのが一番簡単だと思います。

Qエクセル。1から12が循環。

お世話になります。
下記内容をエクセルの計算式で可能ですか?

A1に1と入力→B1,C1に2 3と反映

6と入力→7 8と反映

12と入力→1 2と反映

言葉足らずな点は補足いたします。
よろしくお願いいたします。

Aベストアンサー

同じ解答があるのかな?重複がありましたら、ごめんなさい。

これって、月数の計算ですよね。
B1:
=MOD(A1,12)+1
C1:
=MOD(B1,12)+1

QExcelを使って行列変換をしたい(大量件数)

先日質問させていただいたものです。
さらなる加工が必要になりました。

例えば、
◆test
aaaaaa
iiiiiiiiiiiii
uuuuu
eeeee
ooooo
◆test2
kaaaaa
kiiiiiiiiiii
kuuuuu
keeeee
kooooo
...

これらのデータを
◆test aaaaaa
    iiiiiiiiiiiiii
    uuuuuu
eeeeee
oooooo
◆test2 kaaaaa
     kiiiiiiiiiii
     kuuuu
     keeeee
     koooooo

に変換はできたのですが、今度は
◆test aaaaaaaa iiiiiiiiiii uuuuuuuuuuu eeeeeee oooooo
◆test2 kaaaaaa kiiiiiiiii kuuuuuuuuu keeeeee koooooooo

のように変換する必要がでてしまいました。

マクロなどで一括で変換できないでしょうか。
当方知識が乏しいため困っております。

先日質問させていただいたものです。
さらなる加工が必要になりました。

例えば、
◆test
aaaaaa
iiiiiiiiiiiii
uuuuu
eeeee
ooooo
◆test2
kaaaaa
kiiiiiiiiiii
kuuuuu
keeeee
kooooo
...

これらのデータを
◆test aaaaaa
    iiiiiiiiiiiiii
    uuuuuu
eeeeee
oooooo
◆test2 kaaaaa
     kiiiiiiiiiii
     kuuuu
     keeeee
     koooooo

に変換はできたのですが、今度は
◆test aaaaaaaa iiiiiiiiiii uuuuuuuuuuu eeeee...続きを読む

Aベストアンサー

こんにちは!

別シートに表示しても良いですか?
元データはSheet1のA列にあり、Sheet2に表示するとします。
標準モジュールにしてください。

Sub Sample1()
Dim i As Long, cnt As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.ClearContents
With Worksheets("Sheet1")
For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
If InStr(.Cells(i, "A"), "◆") > 0 Then
cnt = cnt + 1
wS.Cells(cnt, "A") = .Cells(i, "A")
Else
wS.Cells(cnt, Columns.Count).End(xlToLeft).Offset(, 1) = .Cells(i, "A")
End If
Next i
End With
End Sub

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

こんにちは!

別シートに表示しても良いですか?
元データはSheet1のA列にあり、Sheet2に表示するとします。
標準モジュールにしてください。

Sub Sample1()
Dim i As Long, cnt As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.ClearContents
With Worksheets("Sheet1")
For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
If InStr(.Cells(i, "A"), "◆") > 0 Then
cnt = cnt + 1
wS.Cells(...続きを読む

QEXCELで集計する数式について

EXCELで集計する最も最適な数式があれば教えてください。

シート①の表を別のシートに集計して反映させる数式があれば教えてください。

現在はイコールを使って別シートに反映させてますが、集計量が多くなり簡単に対応できなくなってしまい、困っています。
よろしくお願いします。

Aベストアンサー

B1セルに 0
C1セルに =COUNTIF($C$3:C8,"<>0")
右へオートフィル

A14セルに
=IF(ROW(A1)>$F$1,"",INDEX($C$2:$F$2,MATCH(ROW(A1)-1,$B$1:$F$1)))
B14セル
=IF(A14="","",INDEX(A:A,SMALL(IF(INDEX($C$3:$F$8,,MATCH(A14,$C$2:$F$2,0))>0,ROW($C$3:$C$8)),COUNTIF($A$14:A14,A14))))
[Ctrl]+[Shift]+[Enter]配列数式、{}で囲まれる。
C14セル
=IF(A14="","",INDEX($B$3:$B$8,MATCH(B14,$A$3:$A$8,0)))
D14セル
=IF(A14="","",INDEX($C$3:$F$8,MATCH(B14,$A$3:$A$8,0),MATCH(A14,$C$2:$F$2,0)))
A14:D14セル 下へオートフィル

QエクセルVBAで今まで使えていたものが使えなくなった原因を教えてください。

下記コードは「特定のシート(あいうえお、とします。)をコピーして、新しいブックを作り一定の範囲(A1:I38、とします)を値貼り付けし、一部(J:N、とします。)非表示にして任意の名前(L17に名前が出るようにしてありそれを引用してます)を付けて指定の場所(フェイクの為、適当。)へ保存する」という内容のものです。

Sub 保存()
Sheets("あいうえお").Copy
Range("A1:I38").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("J:N").Select
Selection.EntireColumn.Hidden = True
Dim fname As string

fname = Application.GetSaveAsFilename(InitialFileName:="C\:~~~" & Range("L17").Value)

If fname <> "false" Then
ActiveWorkbook.SaveAs Filename:=fname
End If

End Sub

ある時から、「型が一致しません」といったエラーが出るようになってしまいました。
何かをしたという記憶もありませんし、原因が思い当りません。。
自分で調べてみたのですが、どうにもわからなかったのでどうにかお力添えください…

ここに書いたもの以外で必要な情報があれば、できる限り出しますので教えてください。
宜しくお願い致します。

下記コードは「特定のシート(あいうえお、とします。)をコピーして、新しいブックを作り一定の範囲(A1:I38、とします)を値貼り付けし、一部(J:N、とします。)非表示にして任意の名前(L17に名前が出るようにしてありそれを引用してます)を付けて指定の場所(フェイクの為、適当。)へ保存する」という内容のものです。

Sub 保存()
Sheets("あいうえお").Copy
Range("A1:I38").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
...続きを読む

Aベストアンサー

マクロを本格的に書く時は、Select をなくせと言います。
今の段階では、はっきりどこが間違いかというと、以下の部分だけです。
File名が、String 型なら、
>If fname <> "false" Then
この部分は間違っています。"False" です。
文字列をそのまま比較すると、binary 比較になってしまうからです。
StrComp 関数などもありますが、ややこしいので、戻り値のままに扱うか、
もしくは、以下のように Vartype 関数を利用します。

それ以上は、任意の部分に関しては、.Range("L17").Value が確実に代入できているか調べるぐらいしかありません。

'これで試してみていただけますか?
'パスの所は適当に変えてください。

Sub 保存2()
Dim fName As Variant
Dim buf As String
Dim wb As Workbook
Dim myPath As String
 '必要に応じて書き換えてください。
 myPath = ThisWorkbook.Path & "\" '末尾には必ず¥を入れてください。
 Worksheets("あいうえお").Copy
 
 Set wb = ActiveWorkbook
 With ActiveSheet
 .Range("A1:I38").Value = .Range("A1:I38").Value '値コピー
 .Columns("J:N").EntireColumn.Hidden = True
  buf = .Range("L17").Value
  If Trim(buf) = "" Then
   MsgBox "ファイル名がありません。", vbCritical
   Exit Sub
  End If
    fName = Application.GetSaveAsFilename( _
    InitialFileName:=myPath & buf, _
    FileFilter:="Excel Files(xlsx(*.xlsx),xlsm(*.xlsm)", _
    Title:="ファイル保存")
  If VarType(fName) = vbBoolean Then
  wb.Close False
  Exit Sub
  End If
 End With
  wb.SaveAs Filename:=fName, FileFormat:=xlOpenXMLWorkbook
  wb.Close False
End Sub

マクロを本格的に書く時は、Select をなくせと言います。
今の段階では、はっきりどこが間違いかというと、以下の部分だけです。
File名が、String 型なら、
>If fname <> "false" Then
この部分は間違っています。"False" です。
文字列をそのまま比較すると、binary 比較になってしまうからです。
StrComp 関数などもありますが、ややこしいので、戻り値のままに扱うか、
もしくは、以下のように Vartype 関数を利用します。

それ以上は、任意の部分に関しては、.Range("L17").Value が確実に代入できているか...続きを読む

Qエクセル2013 入力した値は正しくありません・・・

自治会の会計帳簿で先月は普通に入力できていたのですが、今月分の入力を始めましたら、日付は入力できたのですが、文字入力をしましたら「入力した値は正しくありません。ユーザーの設定によってセルに入力できる値が制限されています。」と表示されてしまいました。

 担当者が変わり、エクセルの初心者なので、色々と対処しているうちに自分で設定を変えてしまっていたのでしょうか? ちんぷんかんぷんで困っています。
 ご教授の程どうぞよろしくお願い致します。

Aベストアンサー

数字しか入れられないように設定されたセルなのに文字を入力しようとしたとか。
シートを編集している過程で、誤って数字しか入力できないセルをコピーしてきてしまったとか。

他に正しく入力出来ていたシートがあれば、
そこからセルをコピーしてきて貼り付けるのが楽です。

そうで無ければ【データの入力規則】で設定を変更しましょう。


この辺が画像もあって参考になるかな?
(この例では数字0~100しか入力できない設定にしています)

121ware.com > サービス&サポート > Q&A > Q&A番号 012991
https://121ware.com/qasearch/1007/app/servlet/relatedqa?QID=012991


入力規則の指定時に、左下の「すべてクリア」をクリックすると、入力制限が全て解除されます。


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング