エクセルでこんな事できませんか？

質問

関数に関して全くの素人です。お力を借りたいのですが、
まず仮にセルA1にXX1と記入してセルA1にXX2,A3にXX3とセルA100まで記入しておき、セルB1にZZZ1と記入しBの列に同じ文字が記入された時セルC列にお互いのセルA列の文字を記入したいのですが,只３回目の時はD列に記入し若い番号から順番に入れていきたいのですが、仮にA1行 ZZZ1 XX10 A10行 ZZZ1 XX1 XX12 A12行 ZZZ1 XX10
A10行が2箇所でD列使用となります。、説明が下手ですが、判ってもらえるかなぁ？関数でもVBAでもいいのですが、VBAについてもド素人です。よろしくお願いします。

回答No.10

yk3291 · ベストアンサー

3行目からでいいんですよね。
あと、シート1は大丈夫との事ですが、シート1も
影響をうけるはずですので、再度、下記のコードを
シート1とシート2のモジュールに貼り付けなおして
みてください。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer, f As Integer
Dim g As Integer, h As Integer, i As Integer, j As Integer, k As Integer, l As Integer
Dim m As Integer

If Target.Column <> 8 Or Target.Row <= 2 Or Target.Row > Sheets("Sheet1").Range("E65536").End(xlUp).Row Then Exit Sub

Sheets("Sheet1").Range("I3:J" & Sheets("Sheet1").Range("E65536").End(xlUp).Row).Value = Clear
Sheets("Sheet2").Range("I3:J" & Sheets("Sheet2").Range("E65536").End(xlUp).Row).Value = Clear

For a = 3 To Sheets("Sheet1").Range("E65536").End(xlUp).Row

Sheets("処理").Range("A" & a).Value = Sheets("Sheet1").Range("E" & a).Value
Sheets("処理").Range("B" & a).Value = Sheets("Sheet1").Range("H" & a).Value
Sheets("処理").Range("C" & a).Value = Sheets("Sheet1").Range("I" & a).Value

Next a

For b = 3 To Sheets("Sheet2").Range("E65536").End(xlUp).Row

c = Sheets("処理").Range("A65536").End(xlUp).Row + 1

Sheets("処理").Range("A" & c).Value = Sheets("Sheet2").Range("E" & b).Value
Sheets("処理").Range("B" & c).Value = Sheets("Sheet2").Range("H" & b).Value
Sheets("処理").Range("C" & c).Value = Sheets("Sheet2").Range("I" & b).Value

Next b

For d = 1 To Sheets("処理").Range("A65536").End(xlUp).Row

For e = d + 1 To Sheets("処理").Range("A65536").End(xlUp).Row

If Sheets("処理").Range("B" & d).Value = Sheets("処理").Range("B" & e).Value Then Exit For

Next e

If Sheets("処理").Range("B" & d) <> "" Then
Sheets("処理").Range("D" & d).Value = Sheets("処理").Range("A" & e).Value
End If

Next d

For f = Sheets("処理").Range("A65536").End(xlUp).Row To 2 Step -1

For g = f - 1 To 1 Step -1

If Sheets("処理").Range("B" & f).Value = Sheets("処理").Range("B" & g).Value Then Exit For

Next g

If g <> 0 And Sheets("処理").Range("B" & f) <> "" Then
Sheets("処理").Range("C" & f).Value = Sheets("処理").Range("A" & g).Value
End If

Next f

For h = 1 To Sheets("処理").Range("A65536").End(xlUp).Row

If Sheets("処理").Range("C" & h).Value = "" And Sheets("処理").Range("D" & h).Value <> "" Then

Sheets("処理").Range("C" & h).Value = Sheets("処理").Range("D" & h).Value
Sheets("処理").Range("D" & h).Value = ""

End If

If Sheets("処理").Range("C" & h).Value <> "" Then
Sheets("処理").Range("C" & h).Value = "-" & Sheets("処理").Range("C" & h).Value
End If

If Sheets("処理").Range("D" & h).Value <> "" Then
Sheets("処理").Range("D" & h).Value = "/" & Sheets("処理").Range("D" & h).Value
End If

Next h

i = Sheets("Sheet1").Range("E65536").End(xlUp).Row
j = Sheets("Sheet2").Range("E65536").End(xlUp).Row

For k = 3 To i

Sheets("Sheet1").Range("I" & k).Value = Sheets("処理").Range("C" & k).Value
Sheets("Sheet1").Range("J" & k).Value = Sheets("処理").Range("D" & k).Value

Next k

l = 3
For m = i + 1 To Sheets("処理").Range("A65536").End(xlUp).Row

Sheets("Sheet2").Range("I" & l).Value = Sheets("処理").Range("C" & m).Value
Sheets("Sheet2").Range("J" & l).Value = Sheets("処理").Range("D" & m).Value
l = l + 1

Next m

Sheets("処理").Range("A1:D" & Sheets("処理").Range("A65536").End(xlUp).Row).Value = Clear

End Sub

これでどうですか？

お礼

yk3291さん。度々の質問にも素早く答えて頂き、最初考えていたもの以上の完成度の高いものとなっています。。効率よく作業が出来そうです。この度は本当にありがとうございました。感謝致します。
ぽろん。５２歳でした。

回答No.9

yk3291

おおまかに修正してみました。
うまくいくかどうか"?"ですが…。
また、質問の意図に合致した内容になっているかも
"?"ですが、確認してみてください。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer, f As Integer
Dim g As Integer, h As Integer, i As Integer, j As Integer, k As Integer, l As Integer
Dim m As Integer

If Target.Column <> 8 Or Target.Row > Sheets("Sheet1").Range("E65536").End(xlUp).Row Then Exit Sub

Sheets("Sheet1").Range("I1:J" & Sheets("Sheet1").Range("E65536").End(xlUp).Row).Value = Clear
Sheets("Sheet2").Range("I1:J" & Sheets("Sheet2").Range("E65536").End(xlUp).Row).Value = Clear

For a = 1 To Sheets("Sheet1").Range("E65536").End(xlUp).Row

Sheets("処理").Range("A" & a).Value = Sheets("Sheet1").Range("E" & a).Value
Sheets("処理").Range("B" & a).Value = Sheets("Sheet1").Range("H" & a).Value
Sheets("処理").Range("C" & a).Value = Sheets("Sheet1").Range("I" & a).Value

Next a

For b = 1 To Sheets("Sheet2").Range("E65536").End(xlUp).Row

c = Sheets("処理").Range("A65536").End(xlUp).Row + 1

Sheets("処理").Range("A" & c).Value = Sheets("Sheet2").Range("E" & b).Value
Sheets("処理").Range("B" & c).Value = Sheets("Sheet2").Range("H" & b).Value
Sheets("処理").Range("C" & c).Value = Sheets("Sheet2").Range("I" & b).Value

Next b

For d = 1 To Sheets("処理").Range("A65536").End(xlUp).Row

For e = d + 1 To Sheets("処理").Range("A65536").End(xlUp).Row

If Sheets("処理").Range("B" & d).Value = Sheets("処理").Range("B" & e).Value Then Exit For

Next e

If Sheets("処理").Range("B" & d) <> "" Then
Sheets("処理").Range("D" & d).Value = Sheets("処理").Range("A" & e).Value
End If

Next d

For f = Sheets("処理").Range("A65536").End(xlUp).Row To 2 Step -1

For g = f - 1 To 1 Step -1

If Sheets("処理").Range("B" & f).Value = Sheets("処理").Range("B" & g).Value Then Exit For

Next g

If g <> 0 And Sheets("処理").Range("B" & f) <> "" Then
Sheets("処理").Range("C" & f).Value = Sheets("処理").Range("A" & g).Value
End If

Next f

For h = 1 To Sheets("処理").Range("A65536").End(xlUp).Row

If Sheets("処理").Range("C" & h).Value = "" And Sheets("処理").Range("D" & h).Value <> "" Then

Sheets("処理").Range("C" & h).Value = Sheets("処理").Range("D" & h).Value
Sheets("処理").Range("D" & h).Value = ""

End If

If Sheets("処理").Range("C" & h).Value <> "" Then
Sheets("処理").Range("C" & h).Value = "-" & Sheets("処理").Range("C" & h).Value
End If

If Sheets("処理").Range("D" & h).Value <> "" Then
Sheets("処理").Range("D" & h).Value = "/" & Sheets("処理").Range("D" & h).Value
End If

Next h

i = Sheets("Sheet1").Range("E65536").End(xlUp).Row
j = Sheets("Sheet2").Range("E65536").End(xlUp).Row

For k = 1 To i

Sheets("Sheet1").Range("I" & k).Value = Sheets("処理").Range("C" & k).Value
Sheets("Sheet1").Range("J" & k).Value = Sheets("処理").Range("D" & k).Value

Next k

l = 1
For m = i + 1 To Sheets("処理").Range("A65536").End(xlUp).Row

Sheets("Sheet2").Range("I" & l).Value = Sheets("処理").Range("C" & m).Value
Sheets("Sheet2").Range("J" & l).Value = Sheets("処理").Range("D" & m).Value
l = l + 1

Next m

Sheets("処理").Range("A1:D" & Sheets("処理").Range("A65536").End(xlUp).Row).Value = Clear

End Sub

これで多分Ｅ列のダブりにも対応できると思います。

お礼

確認させて頂きました。バッチリでした。しかし・・・・すごいですね。プログラムできる人尊敬します。最終のプログラムと最初のプログラムと見比べて、まずはそこから勉強したいと思います。
今回は本当にありがとうございました。

補足

またもや質問ですけど・・・項目とオートフィルター入れたくて２行下に下げようと、行の挿入しました。sheet1は何ごともなくいけたのですがsheet2の結果覧２列共結果が上にずれるんです。教えてください。　　　　　　　　m(__)m　　ごめんね。

回答No.8

yk3291

ABCD列ではなくEGHIの列を使うという事ですね。
あと空白セルは認識させないという事なら、以下の
コードを再度、シート1とシート2のモジュールに
貼り付けなおしてみて下さい。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer
Dim f As Integer, g As Integer, h As Integer, i As Integer, j As Integer, k As Integer

If Target.Column <> 7 Or Target.Row > Sheets("Sheet1").Range("E65536").End(xlUp).Row Then Exit Sub

Sheets("Sheet1").Range("H1:I" & Sheets("Sheet1").Range("E65536").End(xlUp).Row).Value = Clear
Sheets("Sheet2").Range("H1:I" & Sheets("Sheet2").Range("E65536").End(xlUp).Row).Value = Clear

For a = 1 To Sheets("Sheet1").Range("E65536").End(xlUp).Row

Sheets("処理").Range("A" & a).Value = Sheets("Sheet1").Range("E" & a).Value
Sheets("処理").Range("B" & a).Value = Sheets("Sheet1").Range("G" & a).Value
Sheets("処理").Range("C" & a).Value = Sheets("Sheet1").Range("H" & a).Value

Next a

For b = 1 To Sheets("Sheet2").Range("E65536").End(xlUp).Row

c = Sheets("処理").Range("A65536").End(xlUp).Row + 1

Sheets("処理").Range("A" & c).Value = Sheets("Sheet2").Range("E" & b).Value
Sheets("処理").Range("B" & c).Value = Sheets("Sheet2").Range("G" & b).Value
Sheets("処理").Range("C" & c).Value = Sheets("Sheet2").Range("H" & b).Value

Next b

For d = 1 To Sheets("処理").Range("A65536").End(xlUp).Row

For e = d + 1 To Sheets("処理").Range("A65536").End(xlUp).Row

If Sheets("処理").Range("B" & d).Value = Sheets("処理").Range("B" & e).Value Then Exit For

Next e

If Sheets("処理").Range("B" & d) <> "" Then
Sheets("処理").Range("D" & d).Value = Sheets("処理").Range("A" & e).Value
End If

Next d

For f = Sheets("処理").Range("A65536").End(xlUp).Row To 2 Step -1

For g = f - 1 To 1 Step -1

If Sheets("処理").Range("B" & f).Value = Sheets("処理").Range("B" & g).Value Then Exit For

Next g

If g <> 0 And Sheets("処理").Range("B" & f) <> "" Then
Sheets("処理").Range("C" & f).Value = Sheets("処理").Range("A" & g).Value
End If

Next f

For h = 1 To Sheets("処理").Range("A65536").End(xlUp).Row

If Sheets("処理").Range("C" & h).Value = "" And Sheets("処理").Range("D" & h).Value <> "" Then

Sheets("処理").Range("C" & h).Value = Sheets("処理").Range("D" & h).Value
Sheets("処理").Range("D" & h).Value = ""

End If

If Sheets("処理").Range("C" & h).Value <> "" Then
Sheets("処理").Range("C" & h).Value = "-" & Sheets("処理").Range("C" & h).Value
End If

If Sheets("処理").Range("D" & h).Value <> "" Then
Sheets("処理").Range("D" & h).Value = "/" & Sheets("処理").Range("D" & h).Value
End If

Next h

For i = 1 To Sheets("処理").Range("A65536").End(xlUp).Row

For j = 1 To Sheets("Sheet1").Range("E65536").End(xlUp).Row

If Sheets("Sheet1").Range("E" & j).Value = Sheets("処理").Range("A" & i).Value Then

Sheets("Sheet1").Range("H" & j).Value = Sheets("処理").Range("C" & i).Value
Sheets("Sheet1").Range("I" & j).Value = Sheets("処理").Range("D" & i).Value

End If

Next j

For k = 1 To Sheets("Sheet2").Range("E65536").End(xlUp).Row

If Sheets("Sheet2").Range("E" & k).Value = Sheets("処理").Range("A" & i).Value Then

Sheets("Sheet2").Range("H" & k).Value = Sheets("処理").Range("C" & i).Value
Sheets("Sheet2").Range("I" & k).Value = Sheets("処理").Range("D" & i).Value

End If

Next k

Next i

Sheets("処理").Range("A1:D" & Sheets("処理").Range("A65536").End(xlUp).Row).Value = Clear

End Sub

多分これで出来るかと思いますが…。

あとAUTOCADとの連動についてですが、すいません、
AUTOCADについては私は専門外、まったく知識が
ありません。
私みたいな未熟者ではないプロフェッショナルな
方の回答を待ってください。

お礼

yk3291さん。w(゜o゜)w オオー!もー完璧！！関数教えて頂いた時も感激しましたが、ＶＢＡってすごい。これだけ出来るには、どれだけ勉強すればいいんでしょう。助かりました。ありがとうございました。自分でも勉強していきます。

補足

今、検証していて気がついたのですが、Ｅ列の文字が同じ時は認識できないようです。同じ文字が続く場合もあります。
それと、現在Ｆ列を空けてますが、出来ればＦ、Ｇと２つ空けてＥ，Ｈ，Ｉ，Ｊでお願いしたいんですが・・・おんぶにだっこ状態でm(__)m

回答No.7

yk3291

１点修正です。
修正しなくても全然問題はない部分なのですが、
念の為…。

変数の宣言が足りませんでした。
(作成しながら継ぎ足していった変数を宣言に加える
のを忘れていました。

Dim a As Integer, b As Integer, c As Integer
の部分ですが、

Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer
Dim f As Integer, g As Integer, h As Integer, i As Integer, j As Integer, k As Integer

に変えてください。

でも、変えなくても出来ますが・・・。

回答No.6

rin01

こんにちは～。Rinで～す。。。♪

>SHEET1を途中で切ってSHEET2に入れたいんです。

出来なくはないと思いますが
幾つか教えて下さい。

(1)A列のデータ数は、sheet1とsheet共50行づつで
　固定でしょうか？
　データ数は、増えませんか？

(2)シート数は、2枚限定で増えませんか？

(3)シート数が2枚でも、1つの式でC D列に
　抽出するのは難しそうです。
　なので
　簡単な方法としては、sheet2のデータをsheet1の
　下へ、関数で持っていって、データをまとめてから
　sheet2へ抽出する方法。

　又は、作業シートを1枚作ってsheet1とsheet2の
　データを関数でまとめてから
　それぞれのシートへ抽出する方法が
　考えられます。

そんな方法で良ければ、式を考えてみたいと
思います。

★最後に

提示された表のsheet1とsheet2のC D列の結果を見ますと、一部規則性が分かりません。

C D列の結果は、間違いないでしょうか？

抽出の条件は、最初と同じと思いますが
結果を出すための規則性や条件が、あいまいですと
式も書けないのですが。

補足

何度も申し訳ないです。

項目としては何千とありますのでSheet1で作成し数値に変えてSheet2に
コピペしようと思います。

頂いた式の結果は完璧です。
私が記した表のSHEET1,SHEET2が書き間違えてました。

＞結果を出すための規則性や条件が、あいまいですと
＞式も書けないのですが。

ご迷惑をお掛けしました。結果については非常に満足しています。
貴重な時間を割いて、回答もすぐに頂き、りんさんに感謝！感謝！です。

ＶＢＡも勉強しようと昨日マニュアル購入しました。
（その前に質問するための日本語からかなぁ？）

回答No.5

yk3291

シート1とシート2があって、もう一つ"処理"という
名前のシートを作ってください。
（このシートは存在しているだけで結構です。何も
入力しておく必要はありません。）

その上でＶＢＡのシート1とシート2のモジュール
に以下のコードを貼り付けてみてください。

と言って分かるかな？
分からなければ手順を言っておきます。

ツール→マクロ→VisualBasicEditorを開きます。
左側に表示されてるプロジェクトエクスプローラー
(表示されてなければ表示→プロジェクトエクスプロ
らー）の中のSheet1をダブルクリックすると真っ白
の画面が出るのでそこに下記のコードをコピー→
貼り付けをしてみてください。
Sheet2も同様で。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim a As Integer, b As Integer, c As Integer

If Target.Column <> 2 Or Target.Row > Sheets("Sheet1").Range("A65536").End(xlUp).Row Then Exit Sub

Sheets("Sheet1").Range("C1:D" & Sheets("Sheet1").Range("A65536").End(xlUp).Row).Value = Clear
Sheets("Sheet2").Range("C1:D" & Sheets("Sheet2").Range("A65536").End(xlUp).Row).Value = Clear

For a = 1 To Sheets("Sheet1").Range("A65536").End(xlUp).Row

Sheets("処理").Range("A" & a).Value = Sheets("Sheet1").Range("A" & a).Value
Sheets("処理").Range("B" & a).Value = Sheets("Sheet1").Range("B" & a).Value
Sheets("処理").Range("C" & a).Value = Sheets("Sheet1").Range("C" & a).Value

Next a

For b = 1 To Sheets("Sheet2").Range("A65536").End(xlUp).Row

c = Sheets("処理").Range("A65536").End(xlUp).Row + 1

Sheets("処理").Range("A" & c).Value = Sheets("Sheet2").Range("A" & b).Value
Sheets("処理").Range("B" & c).Value = Sheets("Sheet2").Range("B" & b).Value
Sheets("処理").Range("C" & c).Value = Sheets("Sheet2").Range("C" & b).Value

Next b

For d = 1 To Sheets("処理").Range("A65536").End(xlUp).Row

For e = d + 1 To Sheets("処理").Range("A65536").End(xlUp).Row

If Sheets("処理").Range("B" & d).Value = Sheets("処理").Range("B" & e).Value Then Exit For

Next e

Sheets("処理").Range("D" & d).Value = Sheets("処理").Range("A" & e).Value

Next d

For f = Sheets("処理").Range("A65536").End(xlUp).Row To 2 Step -1

For g = f - 1 To 1 Step -1

If Sheets("処理").Range("B" & f).Value = Sheets("処理").Range("B" & g).Value Then Exit For

Next g

If g <> 0 Then
Sheets("処理").Range("C" & f).Value = Sheets("処理").Range("A" & g).Value
End If

Next f

For h = 1 To Sheets("処理").Range("A65536").End(xlUp).Row

If Sheets("処理").Range("C" & h).Value = "" And Sheets("処理").Range("D" & h).Value <> "" Then

Sheets("処理").Range("C" & h).Value = Sheets("処理").Range("D" & h).Value
Sheets("処理").Range("D" & h).Value = ""

End If

If Sheets("処理").Range("C" & h).Value <> "" Then
Sheets("処理").Range("C" & h).Value = "-" & Sheets("処理").Range("C" & h).Value
End If

If Sheets("処理").Range("D" & h).Value <> "" Then
Sheets("処理").Range("D" & h).Value = "/" & Sheets("処理").Range("D" & h).Value
End If

Next h

For i = 1 To Sheets("処理").Range("A65536").End(xlUp).Row

For j = 1 To Sheets("Sheet1").Range("A65536").End(xlUp).Row

If Sheets("Sheet1").Range("A" & j).Value = Sheets("処理").Range("A" & i).Value Then

Sheets("Sheet1").Range("C" & j).Value = Sheets("処理").Range("C" & i).Value
Sheets("Sheet1").Range("D" & j).Value = Sheets("処理").Range("D" & i).Value

End If

Next j

For K = 1 To Sheets("Sheet2").Range("A65536").End(xlUp).Row

If Sheets("Sheet2").Range("A" & K).Value = Sheets("処理").Range("A" & i).Value Then

Sheets("Sheet2").Range("C" & K).Value = Sheets("処理").Range("C" & i).Value
Sheets("Sheet2").Range("D" & K).Value = Sheets("処理").Range("D" & i).Value

End If

Next K

Next i

Sheets("処理").Range("A1:D" & Sheets("処理").Range("A65536").End(xlUp).Row).Value = Clear

End Sub

これで多分お望みのものが出来ると思いますが
試してみてください。
出来なかったらごめんなさい。

補足

ｙｋ３２９１さん。ご回答ありがとうございます。
なんと！素晴らしい。説明通りにしましたら出来ました。
只、空白も認識しているようで呼び合いしてます。これってどうしたら直せます。それと実はセルの位置もA,B,C,DをE,G,H,IとFをとばし組みたいのですが、関数ですと移動出来ましたが、どこをどう修正していいか判りません。
すみません急ぎませんので教えて下さい。
後、AUTOCADとEXCELもこのVBAで連携したいのですが、そんな事って出来ます？

回答No.4

rin01

>甘えついでにもう１つ

それは、構まわないのですが～。。。

>SHEET2に同じ表を作りお互いに連携も出来ますか？
>SHEET2のＡ列はSHEET1とは異なる文字で・・・

理解力がなくて、ゴメンナサイ!!
連携とは、どういうことでしょう？

文章だけでなく
サンプルの表をアップして
説明して頂ければと思います。
わたしには、poron1109さんのエクセルが
見えませんので。。

。。。。Rin～♪♪

補足

あいや。申し訳ありません。
早々にお返事頂いて、感謝致します。
理解力がないなんてとんでもない。
連携って言うのも可笑しいですね。
SHEET1を途中で切ってSHEET2に入れたいんです。
SHEET1
　　　A　　　B　　　.　C　　.　D
1　　XX1　　ZZZ1 　 -XX3
2　　XX2　　ZZZ2....-BB5
3　　XX3　　ZZZ1　　-XX1 /XX4
4　　XX4　　ZZZ1.... -XX3 /XX6
5　　XX5　　ZZZ3　　-BB2
6　　XX6　　ZZZ1.... -XX4 /BB1
7　　・
50 　XX50

SHEET2
　　　A　　　B　　.　　C..........D
1　　BB1　　ZZZ1 　 -XX6 /BB3
2　　BB2　　ZZZ2.....-XX5 /BB6
3　　BB3　　ZZZ1　　-BB1 /BB4
4　　BB4　　ZZZ1....-BB3
5　　BB5　　ZZZ3　　-XX2
6　　BB6　　ZZZ2....-BB2
7　　・
50　 BB50

こんな感じなんですけど、判って貰えますかね？
スペースが思うように入らないのは何故でしょう？

回答No.3

rin01

おはようございま～す。。。♪

ご希望通りになって、良かったです。。

>Ｃ列の文字の頭に文字が入る時だけハイフォン”－”を入
>れ、Ｄ列には”/ "を入れる事って出来ます？

C列は　-XX4
　　　　-XX1
D列は、 /XX6

の様になれば良いのでしょうか？
でしたら

★C列
C1の式は、要らない式も入っていましたので
少し短くしました。

C1: =IF(COUNTIF(B:B,B1)>1,"-"&INDEX(A:A,MATCH(B1,B2:$B$100,0)+1),"")

C2: =IF(COUNTIF(B:B,B2)<2,"",IF(COUNTIF($B$1:B2,B2)=1,"-"&INDEX(A:A,MATCH(B2,B3:$B$100,0)+ROW()),IF(COUNTIF($B$1:B2,B2)=2,"-"&INDEX(A:A,MATCH(B2,B:B,0)),"-"&INDEX(A:A,LOOKUP(10^7,1/($B$1:B1=B2)*ROW($A$1:A1)))))

C2の式は下にコピーします。

★D列
D1: =IF((COUNTIF($B$1:B1,B1)<2)+(COUNTIF(B2:$B$100,B1)=0),"","/"&INDEX(A:A,MATCH(B1,B2:$B$100,0)+ROW()))

下にコピーして下さい。。。。Rin～♪♪

補足

早速ありがとうございます。
もー完璧です。甘えついでにもう１つ。
SHEET2に同じ表を作りお互いに連携も出来ますか？
SHEET2のＡ列はSHEET1とは異なる文字で・・・

回答No.2

rin01

Rinで～す。。。♪

出かけていて
遅くなりました～。。。。

説明で、まだわからない所がありますが～。。。

提示された表の、B列とC列の結果通りでしたら

★C列は

C1: =IF(COUNTIF($B$1:B1,B1)=1,INDEX(A:A,MATCH(B1,B2:$B$100,0)+1),IF(COUNTIF($B$1:B1,B1)=2,INDEX(A:A,MATCH(B1,B:B,0)),""))

C2: =IF(COUNTIF(B:B,B2)<2,"",IF(COUNTIF($B$1:B2,B2)=1,INDEX(A:A,MATCH(B2,B3:$B$100,0)+ROW()),IF(COUNTIF($B$1:B2,B2)=2,INDEX(A:A,MATCH(B2,B:B,0)),INDEX(A:A,LOOKUP(10^7,1/($B$1:B1=B2)*ROW($A$1:A1))))))

C2の式を下にコピーします。

★D列は

D1: =IF((COUNTIF($B$1:B1,B1)<2)+(COUNTIF(B2:$B$100,B1)=0),"",INDEX(A:A,MATCH(B1,B2:$B$100,0)+ROW()))

下にコピーします。

でした。。。。♪♪

補足

今朝から試してみました。なっ、なんと素晴らしい！希望通りの事が出来る。感謝。感激。雨。台風。自分ですれば何ヶ月も掛かるだろうなぁ。
追加で聞きたいのですが、Ｃ列の文字の頭に文字が入る時だけハイフォン”－”を入れ、Ｄ列には”/ "を入れる事って出来ます？自分でやろうとしたのですが、式が変わってしまいます。お願いします。　　おんぶにだっこ状態ですみません。

回答No.1

rin01

こんにちは～♪

すみません。。
ほとんど理解出来ていませんが～。。。

C列が、こんな表の様になれば良いのでしょうか？

　　　A　　　B　　　　C
1　　XX1　　ZZZ1
2　　XX2　　ZZZ2
3　　XX3　　ZZZ1　　XX3
4　　XX4　　ZZZ1
5　　XX5　　ZZZ2　　XX5
6　　XX6　　ZZZ3
7　　・
100　XX100

C1: =IF(COUNTIF($B$1:B1,B1)=2,A1,"")

下にコピーします。

★D列の説明は、まったくわからないのですが。

>只３回目の時はD列に記入し若い番号から順番

上の表の場合
B4の ZZZZ1 が3回目になりますが
どの値を指すのでしょうか？
それから、4回目以上はどうするのでしょうか？

。。。。Rinでした～♪♪

補足

早速考えて頂きありがとうございます。
説明が下手でやはり伝わってないようですね。すみません。
______ A____ B______C______D
1___XX1__ZZZ1__XX4
2___XX2__YYY1
3___XX3__ZZZ2
4___XX4__ZZZ1__XX1__XX6
5___XX5__BBB1
6___XX6__ZZZ1__XX4__XX7
7___XX7__ZZZ1__XX6
.
.
100 XX100
A列は固定でB列に入力した時に同じ文字であれば、お互いのA列をC列に入れ。3度目、4度目の時はD列に入れたいんです。1行には2箇所以上は記入しなくて、若い順に呼び合いをしたいのですB列のYYY1も同じ文字が出て来ると同様です。見てやって下さい。スペース入れても片寄るので＿いれました。