VB6.0にて、あるデータ項目の内容を、画面上の2つの表示領域に分割して
セットする方法を教えて下さい。

あるファイルの項目として、「住所」という項目があるとします。
このデータを取得し、画面に表示する際に、「住所1」「住所2」とに分割して、
セットします。
この場合、ファイル上の「住所」は、キャラクタタイプで40バイトと定義されており、
”半角/全角文字混在”でデータが格納されています。
画面上の、「住所1」「住所2」はそれぞれ、20バイトとします。

この様な条件で、単純に取得したデータを2分割すると、
取得したデータが、全て半角か全角なら問題はないのですが、
例えば、1文字目が半角で、以降が全て全角文字だった場合に、
最後の全角文字がぴったり収まらなくなり、うまく表示できないように思います。

また、文字を取得する際に、使用している、Mid(MidB)関数やLen(LenB)関数も、
うまく利用できていないようです。(コード体系の違いでしょうか?)

どなたかご教授下さい。
よろしくお願いします。

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

A 回答 (3件)

#1で回答した者です。


#1で示したソースプログラムで理解されると思いますが
念のため補足を致します。

ソースプログラムを実行するとシフトJISコード換算で
住所の21バイト目が全角の2バイト目にあたる場合、
address1には19バイト分の文字列、address2には
20バイト目(全角の1バイト目)以降の文字列が格納されます。

例)
"123456789全角456789全角・・・" → address1="123456789全角456789"
├─ LenB(work)=21 ─┤      address2="全角・・・"
    • good
    • 1
この回答へのお礼

1つめに頂いたご回答とあわせて、ありがとうございました。
サンプルコードまでご提供頂き大変助かりました。
今後もなにかあればまたよろしくお願い致します。

お礼日時:2001/05/04 22:58

シフトJISに変換して分割した後に、分割した部分が漢字の第一バイトと第二バイトの間かどうかをチェックしておいた方が良いでしょうね。


単純にバイト数で切ると、文字化けになる可能性があります。
    • good
    • 0
この回答へのお礼

ありがとうございました。
参考になりました。

お礼日時:2001/05/04 22:57

Mid関数やLen関数は文字単位で処理されますので


全角も半角もそれぞれ1文字として扱われます。
また、MidB関数やLenB関数はバイト単位で処理されますが
VB内部ではUnicode仕様になっていて全角も半角もそれぞれ
2バイトとして扱われます。

ですので、次のようにStrConv関数を使って文字列をUnicodeでなく
システムの既定のコード体系(通常はSHIFT-JIS)に変換して処理すれば
うまく表示することが出来ると思います。

Dim address1 As String, address2 As String
Dim work As String
Dim ii As Integer

For ii = 1 To Len(address) '住所の文字数分繰り返す
work = Left(address, ii) '1文字,2文字・・・と順番に住所を切り出す
work = StrConv(work, vbFromUnicode) 'Unicodeからシステムの既定のコードに変換
If (LenB(work) > 20) Then '20バイトを超えたらEXIT
Exit For 'EXITするとaddress2の先頭文字位置がiiに格納される
End If
Next ii

address1 = Left(address,ii-1) '住所1
address2 = Mid(address,ii) '住所2
    • good
    • 0

このQ&Aに関連する人気のQ&A

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

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

このQ&Aを見た人が検索しているワード

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

Q【VBA】全角半角入り交じった住所を分割

Book1のA列に記載されている市区町村番地を、別のファイルであるBook2のA列とB列に、それぞれ市区町村と番地に分けて転記するVBAを教えていただけますでしょうか。
住所は半角全角が入り交じっていますが、どちらかに統一するのではなく、記載されているとおりに転記したいです。
全角だけ、もしくは半角だけを抜き出すマクロは見つけたのですが、どちらであっても分割できるマクロがわかりません。

下記の住所を、、、
Book1
A列
港区赤坂1−2−3
港区赤坂1-2-3
港区赤坂1-2−3

下記のように分割して別ファイルに転記
Book2
A列    B列
港区赤坂  1−2−3
港区赤坂  1-2-3
港区赤坂  1-2−3

お知恵をお貸し下さい。
よろしくお願いいたします。

Aベストアンサー

こんばんは!

元データはSheet1のA2セル以降にあり、Sheet2に表示するとします。
尚、「番地」は必ず数値から始まるものとします。
標準モジュールにしてください。

Sub Sample1()
Dim i As Long, k As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Range("A:B").ClearContents
With Worksheets("Sheet1")
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
For k = 1 To Len(.Cells(i, "A"))
If Mid(StrConv(.Cells(i, "A"), vbNarrow), k, 1) Like "[0-9]" Then Exit For
Next k
If k < Len(.Cells(i, "A")) Then
wS.Cells(i, "A") = Left(.Cells(i, "A"), k - 1)
wS.Cells(i, "B").NumberFormatLocal = "@"
wS.Cells(i, "B") = Replace(.Cells(i, "A"), wS.Cells(i, "A"), "")
End If
Next i
End With
End Sub

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

こんばんは!

元データはSheet1のA2セル以降にあり、Sheet2に表示するとします。
尚、「番地」は必ず数値から始まるものとします。
標準モジュールにしてください。

Sub Sample1()
Dim i As Long, k As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Range("A:B").ClearContents
With Worksheets("Sheet1")
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
For k = 1 To Len(.Cells(i, "A"))
If Mid(StrConv(.Cells(i, "A"), ...続きを読む

QVBAを使用し取得したフォルダ内のテキストデータも文字数と半角文字の有無を抽出したい。

指定フォルダからファイル名一覧を書き出し
1.B3セルにテキスト名が記載される。(例:sample)
2.C3セルにファイルの種類が表示される(例:TXT ファイル)
の簡単なソースはできたのですが、

3.D3セルにB3のセルのテキストデータ内の全文字数をカウント(数字のみ記載)
4.E3セルにB3で取得した文字数の中に半角の文字が入っているかを確認(入っていたら、1など)

というVBAのファイルを作成したいのですが3.と4.の作成方法がわかりません。

また現在までで出来ているのは、下記のソースまでです。
(初心者のため間違えているところがあるかもしれません)
お教えいただけませんでしょうか。よろしくお願いいたします。

Sub MakeFileList()

Target = InputBox("ディレクトリ名を入力", "ディレクトリの指定", "C:\Windows")

Set FS = CreateObject("Scripting.FileSystemObject")
Set Fol = FS.GetFolder(Target)
Set Fil = Fol.Files
ThisWorkbook.Sheets("Sheet1").UsedRange.Delete

'見出しを付ける
ThisWorkbook.Sheets(1).Range("B2") = "ファイル名"
ThisWorkbook.Sheets(1).Range("C2") = "ファイル種別"
ThisWorkbook.Sheets(1).Range("D2") = "文字数"
ThisWorkbook.Sheets(1).Range("E2") = "半角の有無"
ThisWorkbook.Sheets(1).Range("B2:E2").Interior.Color = RGB(0, 0, 0)
ThisWorkbook.Sheets(1).Range("B2:E2").Font.Color = RGB(255, 255, 255)
ThisWorkbook.Sheets(1).Range("B2:Es2").HorizontalAlignment = xlCenter

i = 3
For Each Fx In Fil
'ファイル名
sFile = Fx.Name
'ファイル名の書き出し
ThisWorkbook.Sheets(1).Cells(i, 2) = sFile
'ファイル種別
sFType = Fx.Type
ThisWorkbook.Sheets(1).Cells(i, 3) = sFType
i = i + 1
Next
End Sub

指定フォルダからファイル名一覧を書き出し
1.B3セルにテキスト名が記載される。(例:sample)
2.C3セルにファイルの種類が表示される(例:TXT ファイル)
の簡単なソースはできたのですが、

3.D3セルにB3のセルのテキストデータ内の全文字数をカウント(数字のみ記載)
4.E3セルにB3で取得した文字数の中に半角の文字が入っているかを確認(入っていたら、1など)

というVBAのファイルを作成したいのですが3.と4.の作成方法がわかりません。

また現在までで出来ているのは、下記のソースまでです...続きを読む

Aベストアンサー

なるべく元のコードに似せて作ってみました。
Microsoft の"Hey Scripting Guy" の解説に半角を数える話があったのですが、半角とか調べるには、Wordオブジェクトを使うのだなんて書かれていました。簡単に思う人もいますが、Wordでは、特殊な技なくしては数えてくれないのです。

あまりはっきり記憶がないけれども、
If LenB(StrConv(sText, vbFromUnicode)) <> Len(sText) *2
で、半角が分かるはずです。ただし、今現在は、半角空白などは考慮に入れていません。

なお。巨大なファイルは試していません。

'//
Sub MakeFileLis2()
 Dim objFS As Object
 Dim objFolder As Object
 Dim objText As Object
 Dim sText As String
 Dim Target As String
 Dim mFolder
 Dim mFiles
 Dim f As Variant, sFile As String, sFType As String
 Dim i As Long
 Dim mPath As String: mPath = CreateObject("WScript.Shell").SpecialFolders.Item(16) 'Documents
 '****セッテング*****
 '見出しを付ける
 ThisWorkbook.Activate
 With Worksheets(1)
  .UsedRange.Clear
  .Range("B2:E2").Value = Array("ファイル名", "ファイル種別", "文字数", "半角の有無")
  .Range("B2:E2").Interior.ColorIndex = xlColorIndexNone
  .Range("B2:E2").Font.ColorIndex = xlColorIndexNone
  .Range("B2:E2").HorizontalAlignment = xlCenter
  
  '****実行*****
  Application.SendKeys "{right}"
  Target = InputBox("ディレクトリ名を入力", "ディレクトリの指定", "C:\Windows")
  'Target = InputBox("ディレクトリ名を入力", "ディレクトリの指定", mPath) こちらは''myDocument になります。
  If StrPtr(Target) = 0 Then Exit Sub 'ESCを押した場合
  If Right(Target, 1) <> "\" Then Target = Target & "\"
  If Dir(Target, vbDirectory) = "" Then
   MsgBox Target & "は存在していません。", vbExclamation
   Exit Sub
  End If
  Set objFS = CreateObject("Scripting.FileSystemObject")
  Set mFolder = objFS.GetFolder(Target)
  Set mFiles = mFolder.Files
  i = 3
  Application.ScreenUpdating = False
  '*****ループのスタート*****
  For Each f In mFiles
   If InStr(f.Type, "テキスト") > 0 Then 'テキストのみにする
   'ファイル名
   sFile = f.Name
   'ファイル名の書き出し
   .Cells(i, 2).Value = sFile
   'ファイル種別
   
   .Cells(i, 3).Value = f.Type
   Set objText = objFS.OpenTextFile(Target & sFile, 1) 'For-Reading
   sText = objText.ReadAll
   sText = Replace(sText, vbCrLf, "") '改行コードは数えない
   .Cells(i, 4).Value = Len(sText)
    If LenB(StrConv(sText, vbFromUnicode)) <> Len(sText) * 2 Then
     .Cells(i, 5).Value = 1
    Else
     .Cells(i, 5).Value = 0
    End If
   objText.Close
   i = i + 1
   '' If i > 50 Then Exit For  '限界を設けることが可能
   End If
  Next
  Application.ScreenUpdating = True
  
  MsgBox "終了", vbInformation
 End With
 Set objFS = Nothing
 
End Sub

なるべく元のコードに似せて作ってみました。
Microsoft の"Hey Scripting Guy" の解説に半角を数える話があったのですが、半角とか調べるには、Wordオブジェクトを使うのだなんて書かれていました。簡単に思う人もいますが、Wordでは、特殊な技なくしては数えてくれないのです。

あまりはっきり記憶がないけれども、
If LenB(StrConv(sText, vbFromUnicode)) <> Len(sText) *2
で、半角が分かるはずです。ただし、今現在は、半角空白などは考慮に入れていません。

なお。巨大なファイルは試していません。

'//...続きを読む

Q全角、半角のデータの抽出方法

あるシステムからデータを受け取る際に氏名の領域が16バイト取ってあるのですがこの領域だけ抽出しようとしたらうまくいきません。
漢字が4バイトでスペースが2バイトの為MID関数を使うと名前の字数で抽出される領域が16バイトとることが出来ないのでうまく16バイト取る方法ご存知の方お教えください。お願いします。

Aベストアンサー

固定長文字列の作成関数を載せました。
「fixStr」関数と命名しております。

参考URL:http://oshiete1.goo.ne.jp/kotaeru.php3?q=172521

QSPREADで全角文字の半角ハイフンが表示出来ません。

こんにちは。全然解決出来なく、大変困っています。
以下、宜しくお願いしますm(_ _)m

VB.NET + SPREAD を使用しています。

全角文字の半角ハイフン(2バイト文字で半角幅のハイフン)がある一定の条件の時に表示されなくて困っています。

例)(DB)「富士山‐吉田」→(SPREAD)「富士山吉田」
(DB)「富士山‐」→(SPREAD)「富士山」
(DB)「‐吉田」→(SPREAD)「吉田」

データはちゃんとセットされている様でそこから
値を取得しテキスト内などに表示すると正常に
値が取れます。

普通のハイフン(全角、半角のハイフン)は、
問題なく表示されます。

移行データのため普通のハイフンへの置換えもできません。

完全なバグであれば諦めも付くのですが・・・。

ご存知な方がいらっしゃいましたら、ぜひ回答を宜しくお願い致します

Aベストアンサー

GrapeCityのHPから公開されているUpdateを最新にしていますか?なんかすご
い数の不具合が出ているようです。

一通り見た感じでは該当するような不具合は無いようですが、意外に直ってしまう場合もあります。お試しください。

参考URL:http://www.grapecity.com/japan/support/powertools_download.htm

Q【Excel VBA】A列の全角・半角文字をチェック

【Excel VBA】A列の全角・半角文字をチェック

Excel VBAの初心者です。
仕事で必要なため、教えていただけると助かります。


【やりたいこと】
Excel VBAで、入力が完了したExcelシートのA列(A1からA10)が、
半角のみであること、または全角が入力されていないこと、を
チェックしたいです。

半角以外の文字があった場合は、メッセージを表示します。
また、半角以外のセルがあった場合は、そのセルの色を水色にします。

入力チェックの方法は、ボタンにマクロを登録して、
そのボタンを押下することで行います。

以下に、僕が試したプログラムを記します。
アドバイスをいただけると幸いです。よろしくお願いします。


Sub 入力チェック()
Dim cellValue As String
Dim strANSI As String
Dim i As Integer

For i = 0 To 10

cellValue = Cells(1, i + 1)
strANSI = StrConv(cellValue, vbFromUnicode)

If Len(cellValue) = LenB(strANSI) Then
MsgBox "セルは半角のみ"
myColor = 8
Else
MsgBox "セルの内容は全角のみ"
End If
MsgBox "セルの内容は全角と半角があり"

Next i
End Sub

【Excel VBA】A列の全角・半角文字をチェック

Excel VBAの初心者です。
仕事で必要なため、教えていただけると助かります。


【やりたいこと】
Excel VBAで、入力が完了したExcelシートのA列(A1からA10)が、
半角のみであること、または全角が入力されていないこと、を
チェックしたいです。

半角以外の文字があった場合は、メッセージを表示します。
また、半角以外のセルがあった場合は、そのセルの色を水色にします。

入力チェックの方法は、ボタンにマクロを登録して、
そのボタンを押下することで行いま...続きを読む

Aベストアンサー

できてるじゃない・・・と思ったら、なるほどw

 誤) cellValue = Cells(1, i + 1)
 正) cellValue = Cells(i + 1, 1)

あとはわかってそーだけど、elseif Lenb/Len = 2 then 半角、else 混在。


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

人気Q&Aランキング

おすすめ情報