シート内の漢字、ひらがな、カタカナを一気に削除したい (ID:12159)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

勉強がてらやってみました。

procedure TForm1.Button1Click(Sender: TObject);
var
  Excel: Variant;
  WorkBook: Variant;
  WorkSheet: Variant;
  Range: Variant;
  vData: array of array of Variant;
  r, c: integer;

//--------------------------------------------------
  //使用できない文字が含まれているかどうか判定する関数
  //--------------------------------------------------
  function IsRightString(const str: string):Boolean;
  var
    i:integer;
  begin
    result := false;
    for i := 1 to Length(str) do
      if not (str[i] in ['a'..'z','A'..'Z','0'..'9']) then exit;
    result := true;
  end;

const
  rMax: integer = 10;
  cMax: integer = 10;

begin
   Excel := CreateOleObject('Excel.Application');
   WorkBook := Excel.Workbooks.Open('d:\temp\test.xls');

try
     WorkSheet := WorkBook.WorkSheets[1];

SetLength(vData, rMax, cMax);

for r:=0 to rMax-1 do begin
      for c:=0 to cMax-1 do begin
        vData[r,c] := WorkSheet.Cells[r+1,c+1].Value;
        if not IsRightString(vData[r,c]) then
          vData[r,c] := '';
      end;
     end;

//シート２へ判定後のデータを代入
     WorkSheet := WorkBook.WorkSheets[2];
     Range := WorkSheet.Range[WorkSheet.Cells[1,1], WorkSheet.Cells[rMax, cMax]];
     Range.value := Variant(vData);

WorkBook.SaveAs( Filename:='d:\temp\test.xls'); //保存
   finally
     WorkBook.close;
     WorkBook:=unAssigned;
     WorkSheet:=unAssigned;
     Excel.Quit;
     Excel:=unAssigned;
  end ;
end;

←解決時は質問者本人がここをチェックしてください。

戻る