一つのセルに複数の表示形式（単位）

質問

数字の先頭に０と入力した時にはＫ（キロ）　１～9の整数で入力した時にはＣ/Ｓ（ケース）

たとえば、Ａ1セルに6と入力した時には6C/Sで表示、06と入力した時には６Ｋで表示を
できる方法を教えてください。

回答No.2

ryo_ky · ベストアンサー

回答１です
一部訂正です。条件の部分を一部ミスしていたので、正しい文章を以下に記します。
（2つめの条件の数字を文字に直しています）

A1のセルに数字が表示された場合は単位がC/Sになりますので条件は
ルール：上位10
書式：G/標準"C/S"

A1のセルに文字が表示された場合は単位がKになりますので条件は
ルール：=A1<>""
書式：@"K"

回答No.8

mitarashi

#6,7です。試してみた物好きな方のためにバグ修正です。

１．シートのズーム変更や、エクセルのウィンドウサイズ変更後の最初の動作時に、前回の設定が残ってエクセルのウィンドウの外に表示されてしまったりする事があるので、UserFormのMe.Hideはやめて、Unload Meに変更して都度消してしまって下さい。当方の環境では重くなる印象はありません。

２．ズーム比をUserFormの幅と、高さにかけてありませんでした。また、ActiveWindow.Zoomは正確で無い（縦横で異なる）という話を思い出して、対処してみました。UserForm_Activateを修正し、realZoomRateという関数を付け足しました。

Private Sub UserForm_Activate()
Dim myLeft As Long, myTop As Long, myWidth As Long, myHeight As Long
Dim zoomX As Single, zoomY As Single
Const myFontSize = 11

realZoomRate zoomX, zoomY
myLeft = ((ActiveCell.Left * DPI / PPI) * zoomX) + R1C1Left
myTop = ((ActiveCell.Top * DPI / PPI) * zoomY) + R1C1Top
myWidth = zoomX * ActiveCell.Width * DPI / PPI
myHeight = zoomY * ActiveCell.Height * DPI / PPI
'フォームの表示順（Zオーダー）、サイズ指定
SetWindowPos m_hwnd, HWND_TOP, myLeft, myTop, myWidth, myHeight, SWP_FRAMECHANGED
Me.TextBox1.Font.Size = Int(myFontSize * zoomY)
Me.TextBox1.Value = ActiveCell.Value
End Sub

'真のズーム倍率を求める 'by kanabunさん
Private Sub realZoomRate(ByRef zoomX As Single, ByRef zoomY As Single)
Dim c As Range
Dim dotX As Long
Dim dotY As Long
Dim dotX1 As Long
Dim dotY1 As Long

Set c = Range("a1")
With ActiveWindow
' ---------- 実際のZoom比の計算 ---------------
dotY = c.Height * DPI / PPI
dotY1 = dotY * .Zoom / 100
zoomY = dotY1 / dotY '実際に適用されているZoom率
dotX = c.Width * DPI / PPI
dotX1 = dotX * .Zoom / 100
zoomX = dotX1 / dotX
End With
End Sub

３．おまけでフォントサイズもズームに応じて変更させてみました。上記に盛り込んであります。

以上。

回答No.7

mitarashi

#6の続きです。
Sheet1のA列でのみ動作する様にしてあります。

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case vbKeyReturn
If IsNumeric(Me.TextBox1.Value) Then
If CDbl(Me.TextBox1.Value) >= 1 Then
If Left(Me.TextBox1.Value, 1) = "0" Then
ActiveCell.Value = Format(Val(Me.TextBox1.Value), "#") & "K"
'書式だけ KまたはC/S表示して、数値として残す場合。後々混乱するかも。
'ActiveCell.Value = CDbl(Me.TextBox1.Value)
'ActiveCell.NumberFormatLocal = "G/標準""K"""
Else
ActiveCell.Value = Me.TextBox1.Value & "C/S"
'ActiveCell.Value = CDbl(Me.TextBox1.Value)
'ActiveCell.NumberFormatLocal = "G/標準""C/S"""
End If
Else
ActiveCell.Value = Me.TextBox1.Value
End If
Else
ActiveCell.Value = Me.TextBox1.Value
End If
Me.Hide
Case vbKeyEscape
Me.Hide
End Select
'お好みで
' ActiveCell.Offset(1, 0).Activate
End Sub

'☆Sheet1モジュール
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'とりえあずA列のみで動作する様にしてある
If Target.Column <> 1 Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
UserForm1.Show
End Sub

' Workbook_BeforeClose(Cancel As Boolean)にも入れて置く方が良いかも
Private Sub Worksheet_Deactivate()
On Error Resume Next
Unload UserForm1
End Sub

回答No.6

mitarashi

きっと採用されないと思いますが、お望みに近い形を実現できたかも
セルを選択すると、セル上にセルと同じサイズのユーザーフォーム（縁なし、メニュー無し）が表示されますので、そこに入力します。
文字列としてKまたはC/Sを付けるのと、コメントアウトしてありますが、書式で付けるのをやってみました。
ユーザー定義書式だけで付けると後々混乱しそうな気がします。
ワークシートのテキストボックスコントロールで当初試みましたが、編集状態にするのがうまくいかず、大げさな事になりました。文字数オーバーなので二つに分けます。

'☆UserForm1モジュール
'TextBox一個を置く。位置、寸法はコードで設定しているので適当で可
'Debugのため、TextBoxには色を付けてあるが、白色でOK

Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function SetWindowPos Lib "user32" _
(ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal uFlags As Long) As Long

Private Const SM_CXSCREEN As Long = 0
Private Const SM_CYSCREEN As Long = 1
Private Const GWL_STYLE = -16
Private Const GWL_EXSTYLE = -20
Private Const WS_CAPTION = &HC00000 'タイトルバーを持つウィンドウ
Private Const WS_SYSMENU = &H80000 'タイトルバー上にウィンドウメニューボックスを持つウィンドウ
Private Const WS_MINIMIZEBOX = &H20000 '最小化ボタンを持つウィンドウ
Private Const WS_MAXIMIZEBOX = &H10000 '最大化ボタンを持つウィンドウ
Private Const WS_EX_DLGMODALFRAME = &H1& '二重の境界線を持つウィンドウ
Private Const HWND_TOPMOST = -1& '常に手前に表示
Private Const HWND_TOP = 0 '手前に表示
Private Const SWP_FRAMECHANGED = &H20
Private Const DPI As Long = 96
Private Const PPI As Long = 72

Dim m_hwnd As Long
Dim R1C1Left As Long
Dim R1C1Top As Long

Private Sub UserForm_Initialize()
With Me
.StartUpPosition = 0
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
'フォームに時刻を名前としてつける
.Caption = .Caption & Timer()
End With
'名前を手がかりとして、ユーザーフォームのハンドルを取得
m_hwnd = FindWindow("ThunderDFrame", Me.Caption)
' フォームのメニュー、最大最小化ボタン等は一切表示しない設定とする
SetWindowLong m_hwnd, GWL_STYLE, _
GetWindowLong(m_hwnd, GWL_STYLE) And _
Not (WS_SYSMENU Or WS_CAPTION Or _
WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
SetWindowLong m_hwnd, GWL_EXSTYLE, _
GetWindowLong(m_hwnd, GWL_EXSTYLE) And _
Not WS_EX_DLGMODALFRAME
With Me.TextBox1
.Top = 0
.Left = 0
.Height = Me.InsideHeight
.Width = Me.InsideWidth
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleNone
.Value = ActiveCell.Value
End With

R1C1Left = ActiveWindow.PointsToScreenPixelsX(0)
R1C1Top = ActiveWindow.PointsToScreenPixelsY(0)
End Sub

Private Sub UserForm_Activate()
Dim myLeft As Long, myTop As Long, myWidth As Long, myHeight As Long

'出典：http://home.att.ne.jp/zeta/gen/excel/c04p06.htm
myLeft = ((ActiveCell.Left * DPI / PPI) * (ActiveWindow.Zoom / 100)) + R1C1Left
myTop = ((ActiveCell.Top * DPI / PPI) * (ActiveWindow.Zoom / 100)) + R1C1Top
myWidth = ActiveCell.Width * DPI / PPI
myHeight = ActiveCell.Height * DPI / PPI
'フォームの表示順（Zオーダー）、サイズ指定
SetWindowPos m_hwnd, HWND_TOP, myLeft, myTop, myWidth, myHeight, SWP_FRAMECHANGED
Me.TextBox1.Value = ActiveCell.Value
End Sub

回答No.5

shirokuma2014

VBAイベントで再挑戦してみました。
「意図した入力方法で表示する」という点に固執してますので、それを上回る問題点がありますｗ

■仕様
1. セルを選択した時に強制的に文字列にします。
2. 1～9の整数を入力すると●C/S。01～09の数値を入力すると●Kになります。
3. 文字列も入力可能です。

■問題点
・小数点は入力できません。
・セルを再選択すると全滅(再び文字列に)します。左上角をクリックした日には悲惨ですｗ
　　・文字列にしないでそのままにすることもできますが、そうすると再入力を受け付けなくなります。
・通常は、範囲を指定して使う機能です。しかしながら範囲指定すると設定が難しくなるので、今回は省いています。

Private Sub Worksheet_Change(ByVal t As Range)

On Error Resume Next

Application.EnableEvents = False
With t
If Len(t) = 1 Then
.Value = CLng(.Value)
.NumberFormatLocal = "0""C/S"""
ElseIf Left(t, 1) = "0" And .Value <> "0" Then
.Value = CLng(.Value)
.NumberFormatLocal = "0""K"""
Else
.Value = CLng(.Value)
.NumberFormatLocal = "0"
End If
End With
Application.EnableEvents = True

End Sub
Private Sub Worksheet_SelectionChange(ByVal t As Range)

t.NumberFormatLocal = "@"

End Sub

回答No.4

keithin

ご利用のエクセルのバージョンがご相談に書かれていませんが。
エクセル２００７以降を使い、次の手順によって実現できます。

手順：
Ａ列を列選択する（必ず行う。以下の操作中すべてこの状態とする）
Ａ列のセルの書式設定の表示形式で文字列を設定しておく
条件付き書式▼から新しいルールを開始
数式を使用して…を選び
数式欄に
=AND("1"<=A1,A1<="9",LEN(A1)=1)
と記入、書式ボタンをクリック
表示形式を選び、ユーザー定義で
@"K"
と設定し、ＯＫＯＫする

改めて条件付き書式▼から新しいルールを開始
数式を使用して…を選び
数式欄に
=LEFT(A1)="0"
と記入、書式ボタンをクリック
表示形式を選び、ユーザー定義で
@"C/S"
と設定し、ＯＫＯＫする

必要に応じてセルに「右寄せ」の設定をしておく。

回答したことと少しでも違うと、できません。

回答No.3

shirokuma2014

ご要望そのままの方法ではありませんが、近いものを。

1. セルを右クリック
2. 「セルの書式設定」
3. 「表示設定」タブ → 「ユーザー定義」
4. 種類に『[<10]#"C/S";#;@K』と入力。

■使い方
・10未満の数字を入れると、●C/Sになります。
・数字の先頭に'を入れると、●Kになります。
　　→ 例えば、'1と入れると1K

■問題点
'と入れたセルは文字列扱いになるため、Sumなどの計算ができなくなります。
また、「文字列を右に揃える」をしないといけません。
少数も入力可能になってしまっています。またセルをクリックしないと小数点以下が見えません。

■01という入力の仕方
エクセル上では、01と入力することは1と入力することと同じと判断されます。
自動的に「数字」となるためです。
たしか条件付き書式やVBAでもこの仕様は崩せなかった覚えがあるけど…。

回答No.1

ryo_ky

質問内容とは完全に一致した方法ではないですが、条件付き書式で近い事はできると思います。

前提として6は数字、06は文字という風に分けるものとします。
A1のセルを選んだ状態で条件付き書式を選択します。

A1のセルに数字が表示された場合は単位がC/Sになりますので条件は
ルール：上位10
書式：G/標準"C/S"

A1のセルに数字が表示された場合は単位がKになりますので条件は
ルール：=A1<>""
書式：@"K"

この方法だと
数字の場合は 6C/S（6と入力）
文字の場合は 06K（'06と入力）
と表示されます。
また質問文の様に6Kと表示させたい場合は'6と入力すれば表示されます。

ただし問題点として数字を文字として入力する場合は'を付けます。そしてこれは文字なので、このセルを参照した計算はできません。