[[20191224141226]]　『文字が含まれている数字の合計』（momo）　ページの最後に飛ぶ

『文字が含まれている数字の合計』（momo）

セルの中に文字と数字があります
文字の種類ごとに最終行から2行目に数字を合計したいです

同じセルに文字と数字のセットは複数ある場合があります
支だったら支店の行に合計、営だったら営業所の行に合計、
本だったら本社の行に合計とします

支店、営業所、本社の合計を出す方法がありましたら教えてください。

　　A　　　　 B　　　　　　C
1　　　　　営5 　　　　　営10
2　　　　　　　　　　　　営4 支15
3　　本7　支8
4
5　支店 8 15
6　営業所 5 14
7　本社　 7
8　合計　　　20　　　　　　29

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

こんにちは＾＾整理のお手伝い等。。。
違っていましたら修正してくださいね。m(_ _)m

B3の様に間にスペースが有る場合もあるのでしょうか＠＠？

    |[A]   |[B]    |[C]    
 [1]|      |営5    |営10   
 [2]|      |       |営4支15
 [3]|      |本7 支8|       
 [4]|      |       |       
 [5]|支店  |      8|     15
 [6]|営業所|      5|     14
 [7]|本社  |      7|       
 [8]|合計　|     20|     29
（隠居じーさん） 2019/12/24(火) 14:59

Sub main()

    Dim c As Range
    '予めA列に支店、営業所、本店、合計と記載しておくこと。
    '集計対象はB,C列
    If WorksheetFunction.CountA(Range("A:A")) > 0 Then
        For Each c In Range("A:A").SpecialCells(2)
            If c.Value = "支店" Then c.Offset(, 1).Resize(, 2).ClearContents
            If c.Value = "営業所" Then c.Offset(, 1).Resize(, 2).ClearContents
            If c.Value = "本店" Then c.Offset(, 1).Resize(, 2).ClearContents
            If c.Value = "合計" Then c.Offset(, 1).Resize(, 2).ClearContents
        Next c
        For Each c In Range("B:C").SpecialCells(2)
            Call subx(c.Value, c.Column)
        Next c
    End If
End Sub

Function subx(arg1, arg2)

    Dim i As Long, rw As Long
    For i = 1 To Len(arg1)
        If Not IsNumeric(Mid(arg1, i, 1)) Then
        rw = Range("A:A").Find(Mid(arg1, i, 1), , , xlPart).Row
        Cells(rw, arg2).Value = Val(Cells(rw, arg2).Value) + Val(Mid(arg1, i + 1))
        rw = Range("A:A").Find("合計", , , xlWhole).Row
        Cells(rw, arg2).Value = Val(Cells(rw, arg2).Value) + Val(Mid(arg1, i + 1))
        End If
    Next i
End Function
（mm） 2019/12/24(火) 15:22

修正
Sub main()

    Dim c As Range
    '予めA列に支店、営業所、本店、合計と記載しておくこと。
    '集計対象はB,C列
    If WorksheetFunction.CountA(Range("A:A")) > 0 Then
        For Each c In Range("A:A").SpecialCells(2)
            If c.Value = "支店" Then c.Offset(, 1).Resize(, 2).ClearContents
            If c.Value = "営業所" Then c.Offset(, 1).Resize(, 2).ClearContents
            If c.Value = "本店" Then c.Offset(, 1).Resize(, 2).ClearContents
            If c.Value = "合計" Then c.Offset(, 1).Resize(, 2).ClearContents
        Next c
        For Each c In Range("B:C").SpecialCells(2)
            Call subx(c.Value, c.Column)
        Next c
    End If
End Sub

Function subx(arg1, arg2)

    Dim i As Long, rw As Long
    For i = 1 To Len(arg1)

        If Mid(arg1, i, 1) = "営" Or Mid(arg1, i, 1) = "支" Or Mid(arg1, i, 1) = "本" Then
        rw = Range("A:A").Find(Mid(arg1, i, 1), , , xlPart).Row
        Cells(rw, arg2).Value = Val(Cells(rw, arg2).Value) + Val(Mid(arg1, i + 1))
        rw = Range("A:A").Find("合計", , , xlWhole).Row
        Cells(rw, arg2).Value = Val(Cells(rw, arg2).Value) + Val(Mid(arg1, i + 1))
        End If

    Next i
End Function
（mm） 2019/12/24(火) 15:25

簡素化
Sub main()

    Dim c As Range
    '予めA列に支店、営業所、本店、合計と記載しておくこと。
    '集計対象はB,C列
    For Each c In Range("A:A").SpecialCells(2)
        If c.Value = "支店" Or c.Value = "営業所" Or c.Value = "本店" Or c.Value = "合計" Then c.Offset(, 1).Resize(, 2).ClearContents
    Next c
    For Each c In Range("B:C").SpecialCells(2)
        Call subx(c.Value, c.Column)
    Next c
End Sub
（mm） 2019/12/24(火) 15:40

隠居じーさん　さん

綺麗に整えて頂きありがとうございます

＞B3の様に間にスペースが有る場合もあるのでしょうか＠＠？

B3のように文字と数字のセットが同じセルに複数ある場合はセットと
セットの間にスペースがあります

（momo） 2019/12/24(火) 15:59

mmさん

2019/12/24(火) 15:40の式は実際のデータで試すとエラー
になりました

Sub main() が黄色くなりましてCall subxにセルが移動してます
コンパイルエラー：subまたはFunctionが定義されておりません

それとA列の項目が増えることがあるかもしれません。
もし増えることがありましたら

If c.Value = "支店" Or c.Value = "営業所" Or c.Value = "本店" Or c.Value = "合計" Then c.Offset(, 1).Resize(, 2).ClearContents

のc.Value = "合計"の後に Or c.Value = "合計2"と追加したら大丈夫でしょうか。

あと実際はB列から最終列まで（その時々で最終列が変わります）合計をだします
その場合は

For Each c In Range("B:C").SpecialCells(2)

のRange("B:C")を変更するだけで大丈夫でしょうか。

詳しくないので全然違うことを言ってましたら申し訳ございません。
今後のために教えてください。

（momo） 2019/12/24(火) 16:21

Function subx(arg1, arg2)

    Dim i As Long, rw As Long
    For i = 1 To Len(arg1)

        If Mid(arg1, i, 1) = "営" Or Mid(arg1, i, 1) = "支" Or Mid(arg1, i, 1) = "本" Then
        rw = Range("A:A").Find(Mid(arg1, i, 1), , , xlPart).Row
        Cells(rw, arg2).Value = Val(Cells(rw, arg2).Value) + Val(Mid(arg1, i + 1))
        rw = Range("A:A").Find("合計", , , xlWhole).Row
        Cells(rw, arg2).Value = Val(Cells(rw, arg2).Value) + Val(Mid(arg1, i + 1))
        End If

    Next i
End Function

を記載してください。
（mm） 2019/12/24(火) 16:36

 B5 =SUMPRODUCT(TEXT(MID(SUBSTITUTE(SUBSTITUTE(B$1:B$4,LEFT($A5),"")," ",REPT(" ",20)),(COLUMN($A:$J)-1)*20+1,20),"0;;0;!0")*1)

 範囲コピー。
（GobGob） 2019/12/25(水) 08:36

mmさん

できるようになりました。
増えていってもできるようになりました。

（momo） 2019/12/26(木) 13:25

GobGobさん

SUBSTITUTE(B$1:B$4,LEFT($A5),"")のB$1:B$4を最終行に取得するように
したいです。

それでINDIRECT関数はどうかと仮シートのK10に最終行数を入力して
それを参照するように試しましたが範囲コピーすると列が可変しないので
＃N/Aとなりました。
何かよい方法はありませんでしょうか。

B5 =SUMPRODUCT(TEXT(MID(SUBSTITUTE(SUBSTITUTE(B$1:INDIRECT("B$"&仮!$K$10),LEFT($A5),"")," ",REPT(" ",20)),(COLUMN($A:$J)-1)*20+1,20),"0;;0;!0")*1)

（momo） 2019/12/26(木) 13:33

 =SUMPRODUCT(TEXT(MID(SUBSTITUTE(SUBSTITUTE(B$1:INDEX(B:B,ROW()-(COUNTA($A$1:$A5))),LEFT($A5),"")," ",REPT(" ",20)),(COLUMN($A:$J)-1)*20+1,20),"0;;0;!0")*1)

 ※A列データ有無見てます。
（GobGob） 2020/01/06(月) 08:11

 一応。
 >＃N/Aとなりました。

 INDIRECTがB列固定だからね。。。。

 B5 =SUMPRODUCT(TEXT(MID(SUBSTITUTE(SUBSTITUTE(B$1:INDEX(B:B,仮!$K$10),LEFT($A5),"")," ",REPT(" ",20)),(COLUMN($A:$J)-1)*20+1,20),"0;;0;!0")*1)

 ※数式セルの行番号が仮シートのK10より小さいと循環参照になるよ。
（GobGob） 2020/01/06(月) 12:40

GobGobさん

"B$"でB列を固定していたんですね。
INDIRECT関数の使い方、勉強しておきます。

＞数式セルの行番号が仮シートのK10より小さいと循環参照になるよ。

ありがとうございます。
気を付けます。

あと1点、教えてほしいのですが。
説明の表にはたまたまなかったのですが稀に少数点第一位もあります。

計算式で小数点第一位まで表示するためには何か方法がありますでしょうか。

（momo） 2020/01/08(水) 12:57

 "0;;0;!0" → "標準;;0;!0"

 に変更
（GobGob） 2020/01/08(水) 13:37

コメント返信：

[ 一覧(最新更新順) ]

[[20191224141226]] 『文字が含まれている数字の合計』（momo） ページの最後に飛ぶ

[[20191224141226]]　『文字が含まれている数字の合計』（momo）　ページの最後に飛ぶ